diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000000000000000000000000000000000..b25c15b81fae06e1c55946ac6270bfdb293870e8
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*~
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
new file mode 100644
index 0000000000000000000000000000000000000000..d4647327328e1456504fba53ff695e7aaf9ac6d6
--- /dev/null
+++ b/.gitlab-ci.yml
@@ -0,0 +1,102 @@
+stages:
+ - build
+
+ifort (debug):
+ stage: build
+ script:
+ - ./configure build --intel --build-type Debug
+ - cd build
+ - make -j8
+ - ctest -VV
+ tags:
+ - ubuntu
+ artifacts:
+ when: on_failure
+ expire_in: 1 week
+ paths:
+ - build/Testing/Temporary/LastTest.log
+
+ifort (release):
+ only:
+ refs:
+ - schedules
+ stage: build
+ script:
+ - ./configure build --intel --build-type Release
+ - cd build
+ - make
+ - ctest -VV
+ tags:
+ - ubuntu
+ artifacts:
+ expire_in: 1 week
+ when: on_failure
+ paths:
+ - build/Testing/Temporary/LastTest.log
+
+ifort-omp (debug):
+# only:
+# refs:
+# - schedules
+ stage: build
+ script:
+ - ./configure build --intel --omp --build-type Debug
+ - cd build
+ - make -j8
+ - ctest -VV
+ tags:
+ - ubuntu
+ artifacts:
+ expire_in: 1 week
+ when: on_failure
+ paths:
+ - build/Testing/Temporary/LastTest.log
+
+
+gnu (debug):
+ stage: build
+ script:
+ - ./configure build --gnu --build-type Debug
+ - cd build
+ - make -j8
+ - ctest -VV
+ tags:
+ - ubuntu
+ artifacts:
+ expire_in: 1 week
+ when: on_failure
+ paths:
+ - build/Testing/Temporary/LastTest.log
+
+gnu-hybrid (debug):
+ stage: build
+ script:
+ - ./configure build --gnu --mpi --omp --build-type Debug
+ - cd build
+ - make -j8
+ - ctest -VV
+ tags:
+ - ubuntu
+ artifacts:
+ expire_in: 1 week
+ when: on_failure
+ paths:
+ - build/Testing/Temporary/LastTest.log
+
+gnu (release):
+ only:
+ refs:
+ - schedules
+ stage: build
+ script:
+ - ./configure build --gnu --build-type Release
+ - cd build
+ - make
+ - ctest -VV
+ tags:
+ - ubuntu
+ artifacts:
+ expire_in: 1 week
+ when: on_failure
+ paths:
+ - build/Testing/Temporary/LastTest.log
diff --git a/CMakeLists.txt b/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..220ee53ba5b9bd290ac97172e4d89184a0391d6b
--- /dev/null
+++ b/CMakeLists.txt
@@ -0,0 +1,252 @@
+# Cmake Project file for RelaxSE
+
+cmake_minimum_required(VERSION 3.0)
+project (RelaxSE)
+
+# these are paths that CMake will search for cmake
+# module files that end with .cmake
+list(APPEND CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake)
+
+enable_language (Fortran)
+
+find_package( LAPACK REQUIRED )
+find_package( BLAS REQUIRED )
+
+# make sure that the default is a RELEASE
+if (NOT CMAKE_BUILD_TYPE)
+ set (CMAKE_BUILD_TYPE RELEASE CACHE STRING
+ "Choose the type of build, options are: None Debug Release Opt Profiling."
+ FORCE)
+endif (NOT CMAKE_BUILD_TYPE)
+
+if (CMAKE_BUILD_TYPE MATCHES Debug)
+ message ("Debug build ")
+ add_definitions(-DVAR_DEBUG)
+elseif (CMAKE_BUILD_TYPE MATCHES Check)
+ message ("Debug build with extra checks")
+ add_definitions(-DVAR_DEBUG)
+else()
+ message ("Build type " ${CMAKE_BUILD_TYPE})
+endif ()
+
+if(ENABLE_NOGEN)
+ message ("Naive (non-generated) implementation -- only for test purposes")
+ add_definitions(-DVAR_NOGEN)
+endif()
+
+# default installation
+get_filename_component (default_prefix ".." ABSOLUTE)
+set (CMAKE_INSTALL_PREFIX ${default_prefix} CACHE STRING
+ "Choose the installation directoryy."
+ FORCE)
+
+# FFLAGS depend on the compiler
+get_filename_component (Fortran_COMPILER_NAME ${CMAKE_Fortran_COMPILER} NAME)
+
+if (CMAKE_Fortran_COMPILER_ID MATCHES GNU)
+ # gfortran
+ set (CMAKE_Fortran_FLAGS_OPT "-funroll-all-loops -fno-f2c -O3")
+ set (CMAKE_Fortran_FLAGS_RELEASE "-O2")
+ set (CMAKE_Fortran_FLAGS_DEBUG "-fno-f2c -O0 -g -fbacktrace ")
+ set (CMAKE_Fortran_FLAGS_CHECK "${CMAKE_Fortran_FLAGS_DEBUG} -Wall -Wextra -Warray-temporaries -Wconversion -Wrealloc-lhs -ffree-line-length-0 -fcheck=all -ffpe-trap=zero,overflow,underflow -finit-real=nan") #-fimplicit-none
+ set(CMAKE_Fortran_FLAGS_PROFILE "${CMAKE_Fortran_FLAGS_RELEASE} -g -pg")
+ if(ENABLE_STATIC_LINKING)
+ set(CMAKE_Fortran_FLAGS
+ "${CMAKE_Fortran_FLAGS} -static"
+ )
+ endif()
+ add_definitions(-DVAR_GNU)
+ if(ENABLE_OMP)
+ add_definitions(-DVAR_OMP)
+ set(CMAKE_Fortran_FLAGS
+ "${CMAKE_Fortran_FLAGS} -fopenmp"
+ )
+ endif()
+
+ if (CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER 10)
+ set(CMAKE_Fortran_FLAGS
+ "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch"
+ )
+ endif()
+
+elseif (CMAKE_Fortran_COMPILER_ID MATCHES Intel)
+ # ifort
+ set (CMAKE_Fortran_FLAGS_OPT "-O3")
+ set (CMAKE_Fortran_FLAGS_RELEASE "-O2")
+ set (CMAKE_Fortran_FLAGS_DEBUG "-O0 -g -traceback")
+ set (CMAKE_Fortran_FLAGS_CHECK "${CMAKE_Fortran_FLAGS_DEBUG} -check all -check arg_temp_created")
+ set (CMAKE_SHARED_LIBRARY_LINK_Fortran_FLAGS "-shared-intel")
+ add_definitions(-DVAR_INTEL)
+ if(ENABLE_OMP)
+ add_definitions(-DVAR_OMP)
+ if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 18)
+ set(CMAKE_Fortran_FLAGS
+ "${CMAKE_Fortran_FLAGS} -qopenmp -qoverride-limits" #-threadprivate:compat
+ )
+ else()
+ set(CMAKE_Fortran_FLAGS
+ "${CMAKE_Fortran_FLAGS} -fopenmp"
+ )
+ endif()
+ endif()
+endif ()
+
+if(ENABLE_MPI)
+ find_package(MPI)
+ if(MPI_Fortran_FOUND)
+ add_definitions(-DVAR_MPI)
+ else()
+ message(FATAL_ERROR "-- You asked for MPI, but CMake could not find any MPI installation, check $PATH")
+ endif()
+endif()
+
+include(RelaxSE_Sources)
+
+# Common Libraries
+add_library(RelaxSE_common
+ ${RELAXSE_COMMON})
+
+if(MPI_Fortran_FOUND)
+ target_include_directories(RelaxSE_common PRIVATE
+ ${MPI_Fortran_INCLUDE_PATH})
+ target_link_libraries(RelaxSE_common
+ ${MPI_Fortran_LIBRARIES}
+ )
+endif()
+
+add_library(RelaxSE_IO
+ ${RELAXSE_SOURCES_IO})
+
+add_dependencies(RelaxSE_IO RelaxSE_common)
+
+add_library(RelaxSE_type
+ ${RELAXSE_SOURCES_TYPE})
+
+add_dependencies(RelaxSE_type RelaxSE_IO)
+add_dependencies(RelaxSE_type RelaxSE_common)
+
+#Generated or non-generated Code
+if(ENABLE_NOGEN)
+ add_library(RelaxSE_lib
+ ${RELAXSE_SOURCES}
+ ${RELAXSE_generator_SOURCES})
+else ()
+ add_library(RelaxSE_fockgen
+ ${RELAXSE_fockgen_SOURCES})
+ add_dependencies(RelaxSE_fockgen RelaxSE_IO)
+ add_dependencies(RelaxSE_fockgen RelaxSE_common)
+ add_dependencies(RelaxSE_fockgen RelaxSE_type)
+
+ add_library(RelaxSE_intgen
+ ${RELAXSE_intgen_SOURCES})
+ add_dependencies(RelaxSE_intgen RelaxSE_IO)
+ add_dependencies(RelaxSE_intgen RelaxSE_common)
+ add_dependencies(RelaxSE_intgen RelaxSE_type)
+
+ add_library(RelaxSE_lib
+ ${RELAXSE_SOURCES}
+ ${RELAXSE_gen_SOURCES})
+ add_dependencies(RelaxSE_lib RelaxSE_fockgen)
+ add_dependencies(RelaxSE_lib RelaxSE_intgen)
+endif()
+
+add_dependencies(RelaxSE_lib RelaxSE_type)
+add_dependencies(RelaxSE_lib RelaxSE_IO)
+add_dependencies(RelaxSE_lib RelaxSE_common)
+
+add_library(RelaxSE_prop
+ ${RELAXSE_SOURCES_prop})
+add_dependencies(RelaxSE_prop RelaxSE_type)
+add_dependencies(RelaxSE_prop RelaxSE_IO)
+add_dependencies(RelaxSE_prop RelaxSE_common)
+add_dependencies(RelaxSE_prop RelaxSE_lib)
+
+
+if(MPI_Fortran_FOUND)
+ target_include_directories(RelaxSE_lib PRIVATE
+ ${MPI_Fortran_INCLUDE_PATH})
+ target_link_libraries(RelaxSE_lib
+ ${MPI_Fortran_LIBRARIES}
+ )
+endif()
+
+
+#Executables
+if(ENABLE_NOGEN)
+ ### Code generator for the diagonal part
+ add_executable(hdiag.x src/generator/code_gener_hdiag.F90)
+ target_link_libraries(hdiag.x
+ RelaxSE_lib
+ RelaxSE_type
+ RelaxSE_IO
+ RelaxSE_common
+ ${LAPACK_LIBRARIES}
+ ${BLAS_LIBRARIES}
+ )
+
+ ### Code generator for the off-diagonal part
+ add_executable(hvblock.x src/generator/code_gener_hv_blocs.F90)
+ target_link_libraries(hvblock.x
+ RelaxSE_lib
+ RelaxSE_type
+ RelaxSE_IO
+ RelaxSE_common
+ ${LAPACK_LIBRARIES}
+ ${BLAS_LIBRARIES}
+ )
+
+ execute_process(COMMAND cp -r ${CMAKE_SOURCE_DIR}/src/generator/update_gencode.sh ${CMAKE_BINARY_DIR}/)
+
+ ### SASS program
+ add_executable(relaxse.x src/RelaxSE.F90)
+ target_link_libraries(relaxse.x
+ RelaxSE_lib
+ RelaxSE_type
+ RelaxSE_IO
+ RelaxSE_common
+ ${LAPACK_LIBRARIES}
+ ${BLAS_LIBRARIES}
+ )
+else()
+ ### SASS program
+ add_executable(relaxse.x src/RelaxSE.F90)
+ target_link_libraries(relaxse.x
+ RelaxSE_lib
+ RelaxSE_type
+ RelaxSE_IO
+ RelaxSE_common
+ RelaxSE_fockgen
+ RelaxSE_intgen
+ ${LAPACK_LIBRARIES}
+ ${BLAS_LIBRARIES}
+ )
+endif()
+
+### Code for properties calculations
+add_executable(prop.x src/prop.F90)
+target_link_libraries(prop.x
+ RelaxSE_lib
+ RelaxSE_prop
+ RelaxSE_type
+ RelaxSE_IO
+ RelaxSE_common
+ ${LAPACK_LIBRARIES}
+ ${BLAS_LIBRARIES}
+ )
+
+### Unitests
+enable_testing()
+
+include(Test_Sources)
+
+# copy test scripts to build/test
+execute_process(COMMAND mkdir -p ${CMAKE_BINARY_DIR}/test)
+execute_process(COMMAND cp -r ${CMAKE_SOURCE_DIR}/test/runtest ${CMAKE_BINARY_DIR}/test)
+execute_process(COMMAND cp ${CMAKE_SOURCE_DIR}/test/runtest_config.py ${CMAKE_BINARY_DIR}/test)
+execute_process(COMMAND cp ${CMAKE_SOURCE_DIR}/test/runtest_relaxse.py ${CMAKE_BINARY_DIR}/test)
+execute_process(COMMAND cp ${CMAKE_SOURCE_DIR}/test/runtest_v1.py ${CMAKE_BINARY_DIR}/test)
+
+include(TestsRelaxSE)
+
+include(CTest)
+
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000000000000000000000000000000000000..f288702d2fa16d3cdf0035b15a9fcbc552cd88e7
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ <program> Copyright (C) <year> <name of author>
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<https://www.gnu.org/licenses/>.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/COPYING.LESSER b/COPYING.LESSER
new file mode 100644
index 0000000000000000000000000000000000000000..153d416dc8d2d60076698ec3cbfce34d91436a03
--- /dev/null
+++ b/COPYING.LESSER
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
\ No newline at end of file
diff --git a/LGPL_header.txt b/LGPL_header.txt
new file mode 100644
index 0000000000000000000000000000000000000000..3841ec75b433e9ef452174d5b92e4a9ca12c8062
--- /dev/null
+++ b/LGPL_header.txt
@@ -0,0 +1,59 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+
+
+ write(f_gen,'(A)') '!!-------------------------------------------------------'
+ write(f_gen,'(A)') '!!---- Relaxed Selected Excitation (RelaxSE)'
+ write(f_gen,'(A)') '!!-------------------------------------------------------'
+ write(f_gen,'(A)') '!!---- This file is part of RelaxSE'
+ write(f_gen,'(A)') '!!---- '
+ write(f_gen,'(A)') '!!---- The RelaxSE project is distributed under LGPL. In agreement with the'
+ write(f_gen,'(A)') '!!---- Intergovernmental Convention of the ILL, this software cannot be used'
+ write(f_gen,'(A)') '!!---- in military applications.'
+ write(f_gen,'(A)') '!!---- '
+ write(f_gen,'(A)') '!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE'
+ write(f_gen,'(A)') '!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE'
+ write(f_gen,'(A)') '!!---- '
+ write(f_gen,'(A)') '!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr'
+ write(f_gen,'(A)') '!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr'
+ write(f_gen,'(A)') '!!---- '
+ write(f_gen,'(A)') '!!---- RelaxSE is free software; you can redistribute it and/or'
+ write(f_gen,'(A)') '!!---- modify it under the terms of the GNU Lesser General Public'
+ write(f_gen,'(A)') '!!---- License as published by the Free Software Foundation; either'
+ write(f_gen,'(A)') '!!---- version 3.0 of the License, or (at your option) any later version.'
+ write(f_gen,'(A)') '!!---- '
+ write(f_gen,'(A)') '!!---- RelaxSE is distributed in the hope that it will be useful,'
+ write(f_gen,'(A)') '!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of'
+ write(f_gen,'(A)') '!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU'
+ write(f_gen,'(A)') '!!---- Lesser General Public License for more details.'
+ write(f_gen,'(A)') '!!---- '
+ write(f_gen,'(A)') '!!---- You should have received a copy of the GNU Lesser General Public'
+ write(f_gen,'(A)') '!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.'
+ write(f_gen,'(A)') '!!---- '
diff --git a/README.md b/README.md
index 67f2ea51f6d5678983d0403e4ece0f78b5e5aca5..1a579ef8118f37e31453240943955feb7af3d5c4 100644
--- a/README.md
+++ b/README.md
@@ -1,2 +1,54 @@
# relaxse-code
+--------------------------------------------------
+# Relaxed Selected Excitation (RelaxSE)
+--------------------------------------------------
+
+The RelaxSE project is distributed under LGPL. In agreement with the
+Intergovernmental Convention of the ILL, this software cannot be used
+in military applications.
+
+Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+ Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+
+Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+ Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+
+RelaxSE is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 3.0 of the License, or (at your option) any later version.
+
+RelaxSE is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, see <http://www.gnu.org/licenses/>.
+
+---
+# Compilation
+---
+
+## Dependencies
+- cmake (>3.5) python (>3.4)
+- fortran compiler (gfortran or ifort)
+- OpenMP and/or MPI for parallel compilation
+- blas and lapack libraries
+
+NB: for linux it might be necessary to make a symlink for blas and lapack
+ln -s libblas.so.3 libblas.a
+ln -s liblapack.so.3 liblapack.a
+
+## Configure
+- ./configure buildname
+- cd buildname
+- make
+
+## Running
+- INPUT, file.ref0, file.TraInt, file.TraOne in the same directory
+- relaxse.x
+
+## Compilation options
+CC=`which gcc` CXX=`which g++` FC=`which gfortran` ./configure --build-type Debug builddir
diff --git a/cmake/RelaxSE_Sources.cmake b/cmake/RelaxSE_Sources.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..c7168d51a32555ad73ae96907a1b14e5e0163737
--- /dev/null
+++ b/cmake/RelaxSE_Sources.cmake
@@ -0,0 +1,98 @@
+set(RELAXSE_COMMON
+ src/dimensions.F90
+ src/utils_char.F90
+ src/files.F90
+ )
+
+set(RELAXSE_SOURCES_IO
+ src/info.F90
+ src/def_files.F90
+ src/cio.h
+ src/cio.c
+ src/molcastype.h
+ src/sort.F90
+ )
+
+set(RELAXSE_SOURCES_TYPE
+ src/all_case.F90
+ src/utils_bits.F90
+ src/typedet.F90
+ src/utils.F90
+ src/vec_storage.F90
+ src/hole_part_cases.F90
+ src/type_twoint.F90
+ src/typetargetvec.F90
+ src/detact.F90
+ src/typebraket.F90
+ src/spindetact.F90
+ src/utils_twoint.F90
+ src/utils_det.F90
+ src/utils_wrt.F90
+ )
+
+set(RELAXSE_SOURCES
+ src/jacscf.f
+ #src/given.f
+ src/orthog.F90
+ src/diag.F90
+ src/explicit_Hmat.F90
+ src/lect_data.F90
+ src/lect_int.F90
+ src/orb_ordering.F90
+ src/ordre.F90
+ src/ref0.F90
+ src/ref1.F90
+ src/RelaxSE_diag.F90
+
+ src/screening.F90
+ src/fock.F90
+ src/gener_guess.F90
+ src/gener_diagJK.F90
+ src/gener_det.F90
+
+ src/utils_batch.F90
+ src/mpi_blockpair.F90
+ src/hv_blocs.F90
+ src/hv_blocs_int.F90
+ src/compute_hv.F90
+ )
+
+set(RELAXSE_generator_SOURCES
+ src/generator/all_case_gen.F90
+ src/generator/codegen_hdiag_block.F90
+ src/generator/codegen_hv_blocs.F90
+ src/generator/codegen_hv_blocs_int.F90
+ src/generator/codegen_hv_blocs_2hj.F90
+ )
+
+include(RelaxSE_gen)
+
+set(RELAXSE_gen_SOURCES
+ src/gencode/generated.F90
+ src/gencode/hv_generated.F90
+ src/gencode/fock_generated.F90
+ src/gencode/aaaa_generated.F90
+ src/gencode/vvaa_generated.F90
+ src/gencode/vaao_generated.F90
+ src/gencode/vaaa_generated.F90
+ src/gencode/aaoo_generated.F90
+ src/gencode/aaao_generated.F90
+ src/gencode/vvoo_generated.F90
+ src/gencode/vvao_generated.F90
+ src/gencode/vaoo_generated.F90
+ src/gencode/vava_generated.F90
+ src/gencode/vvvo_generated.F90
+ src/gencode/vvva_generated.F90
+ src/gencode/vvvv_generated.F90
+ src/gencode/oooo_generated.F90
+ src/gencode/vovo_generated.F90
+ src/gencode/aooo_generated.F90
+ src/gencode/vavo_generated.F90
+ src/gencode/vooo_generated.F90
+ src/gencode/aoao_generated.F90
+ src/gencode/voao_generated.F90
+ )
+
+
+
+include(RelaxSE_prop)
diff --git a/cmake/RelaxSE_gen.cmake b/cmake/RelaxSE_gen.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..17f69d2022c35a36a783661dbb96547116ea8443
--- /dev/null
+++ b/cmake/RelaxSE_gen.cmake
@@ -0,0 +1,304 @@
+set(RELAXSE_fockgen_SOURCES
+ src/gencode/fock_000_000_generated.F90
+ src/gencode/fock_000_p01_generated1.F90
+ src/gencode/fock_000_p01_generated2.F90
+ src/gencode/fock_000_p11_generated.F90
+ src/gencode/fock_000_m11_generated1.F90
+ src/gencode/fock_000_m11_generated2.F90
+ src/gencode/fock_p01_p01_generated1.F90
+ src/gencode/fock_p01_p01_generated2.F90
+ src/gencode/fock_p01_p02_generated1.F90
+ src/gencode/fock_p01_p02_generated2.F90
+ src/gencode/fock_p01_p02_generated3.F90
+ src/gencode/fock_p01_p02_generated4.F90
+ src/gencode/fock_p01_p11_generated1.F90
+ src/gencode/fock_p01_p11_generated2.F90
+ src/gencode/fock_p01_p12_generated1.F90
+ src/gencode/fock_p01_p12_generated2.F90
+ src/gencode/fock_p01_m11_generated1.F90
+ src/gencode/fock_p01_m11_generated2.F90
+ src/gencode/fock_p01_m12_generated1.F90
+ src/gencode/fock_p01_m12_generated2.F90
+ src/gencode/fock_p01_m12_generated3.F90
+ src/gencode/fock_p01_m12_generated4.F90
+ src/gencode/fock_p02_p02_generated1.F90
+ src/gencode/fock_p02_p02_generated2.F90
+ src/gencode/fock_p02_p02_generated3.F90
+ src/gencode/fock_p02_p02_generated4.F90
+ src/gencode/fock_p02_p12_generated1.F90
+ src/gencode/fock_p02_p12_generated2.F90
+ src/gencode/fock_p02_p12_generated3.F90
+ src/gencode/fock_p02_p12_generated4.F90
+ src/gencode/fock_p02_m12_generated1.F90
+ src/gencode/fock_p02_m12_generated2.F90
+ src/gencode/fock_p02_m12_generated3.F90
+ src/gencode/fock_p02_m12_generated4.F90
+ src/gencode/fock_p11_p11_generated.F90
+ src/gencode/fock_p11_p12_generated1.F90
+ src/gencode/fock_p11_p12_generated2.F90
+ src/gencode/fock_p11_p20_generated.F90
+ src/gencode/fock_p12_p12_generated1.F90
+ src/gencode/fock_p12_p12_generated2.F90
+ src/gencode/fock_p12_p20_generated1.F90
+ src/gencode/fock_p12_p20_generated2.F90
+ src/gencode/fock_m11_m11_generated1.F90
+ src/gencode/fock_m11_m11_generated2.F90
+ src/gencode/fock_m11_m12_generated1.F90
+ src/gencode/fock_m11_m12_generated2.F90
+ src/gencode/fock_m11_m12_generated3.F90
+ src/gencode/fock_m11_m12_generated4.F90
+ src/gencode/fock_m11_m20_generated1.F90
+ src/gencode/fock_m11_m20_generated2.F90
+ src/gencode/fock_m11_m20_generated3.F90
+ src/gencode/fock_m11_m20_generated4.F90
+ src/gencode/fock_m12_m12_generated1.F90
+ src/gencode/fock_m12_m12_generated2.F90
+ src/gencode/fock_m12_m12_generated3.F90
+ src/gencode/fock_m12_m12_generated4.F90
+ src/gencode/fock_m12_m20_generated1.F90
+ src/gencode/fock_m12_m20_generated2.F90
+ src/gencode/fock_m12_m20_generated3.F90
+ src/gencode/fock_m12_m20_generated4.F90
+ src/gencode/fock_p20_p20_generated.F90
+ src/gencode/fock_m20_m20_generated1.F90
+ src/gencode/fock_m20_m20_generated2.F90
+ src/gencode/fock_m20_m20_generated3.F90
+ src/gencode/fock_m20_m20_generated4.F90
+)
+
+set(RELAXSE_intgen_SOURCES
+ src/gencode/aaaa_000_000_generated.F90
+ src/gencode/aaaa_p01_p01_generated1.F90
+ src/gencode/aaaa_p01_p01_generated2.F90
+ src/gencode/aaaa_p02_p02_generated1.F90
+ src/gencode/aaaa_p02_p02_generated2.F90
+ src/gencode/aaaa_p02_p02_generated3.F90
+ src/gencode/aaaa_p02_p02_generated4.F90
+ src/gencode/aaaa_p11_p11_generated.F90
+ src/gencode/aaaa_p12_p12_generated1.F90
+ src/gencode/aaaa_p12_p12_generated2.F90
+ src/gencode/aaaa_m11_m11_generated1.F90
+ src/gencode/aaaa_m11_m11_generated2.F90
+ src/gencode/aaaa_m12_m12_generated1.F90
+ src/gencode/aaaa_m12_m12_generated2.F90
+ src/gencode/aaaa_m12_m12_generated3.F90
+ src/gencode/aaaa_m12_m12_generated4.F90
+ src/gencode/aaaa_p20_p20_generated.F90
+ src/gencode/aaaa_m20_m20_generated1.F90
+ src/gencode/aaaa_m20_m20_generated2.F90
+ src/gencode/aaaa_m20_m20_generated3.F90
+ src/gencode/aaaa_m20_m20_generated4.F90
+ src/gencode/aaao_000_p11_generated.F90
+ src/gencode/aaao_p01_p12_generated1.F90
+ src/gencode/aaao_p01_p12_generated2.F90
+ src/gencode/aaao_p01_m11_generated1.F90
+ src/gencode/aaao_p01_m11_generated2.F90
+ src/gencode/aaao_p02_m12_generated1.F90
+ src/gencode/aaao_p02_m12_generated2.F90
+ src/gencode/aaao_p02_m12_generated3.F90
+ src/gencode/aaao_p02_m12_generated4.F90
+ src/gencode/aaao_p11_p20_generated.F90
+ src/gencode/aaao_m12_m20_generated1.F90
+ src/gencode/aaao_m12_m20_generated2.F90
+ src/gencode/aaao_m12_m20_generated3.F90
+ src/gencode/aaao_m12_m20_generated4.F90
+ src/gencode/vaaa_000_m11_generated1.F90
+ src/gencode/vaaa_000_m11_generated2.F90
+ src/gencode/vaaa_p01_p11_generated1.F90
+ src/gencode/vaaa_p01_p11_generated2.F90
+ src/gencode/vaaa_p01_m12_generated1.F90
+ src/gencode/vaaa_p01_m12_generated2.F90
+ src/gencode/vaaa_p01_m12_generated3.F90
+ src/gencode/vaaa_p01_m12_generated4.F90
+ src/gencode/vaaa_p02_p12_generated1.F90
+ src/gencode/vaaa_p02_p12_generated2.F90
+ src/gencode/vaaa_p02_p12_generated3.F90
+ src/gencode/vaaa_p02_p12_generated4.F90
+ src/gencode/vaaa_p12_p20_generated1.F90
+ src/gencode/vaaa_p12_p20_generated2.F90
+ src/gencode/vaaa_m11_m20_generated1.F90
+ src/gencode/vaaa_m11_m20_generated2.F90
+ src/gencode/vaaa_m11_m20_generated3.F90
+ src/gencode/vaaa_m11_m20_generated4.F90
+ src/gencode/aaoo_p01_p01_generated1.F90
+ src/gencode/aaoo_p01_p01_generated2.F90
+ src/gencode/aaoo_p02_p02_generated1.F90
+ src/gencode/aaoo_p02_p02_generated2.F90
+ src/gencode/aaoo_p02_p02_generated3.F90
+ src/gencode/aaoo_p02_p02_generated4.F90
+ src/gencode/aaoo_p11_p11_generated.F90
+ src/gencode/aaoo_p12_p12_generated1.F90
+ src/gencode/aaoo_p12_p12_generated2.F90
+ src/gencode/aaoo_m12_m12_generated1.F90
+ src/gencode/aaoo_m12_m12_generated2.F90
+ src/gencode/aaoo_m12_m12_generated3.F90
+ src/gencode/aaoo_m12_m12_generated4.F90
+ src/gencode/aaoo_p20_p20_generated.F90
+ src/gencode/vaao_000_p01_generated1.F90
+ src/gencode/vaao_000_p01_generated2.F90
+ src/gencode/vaao_p01_p02_generated1.F90
+ src/gencode/vaao_p01_p02_generated2.F90
+ src/gencode/vaao_p01_p02_generated3.F90
+ src/gencode/vaao_p01_p02_generated4.F90
+ src/gencode/vaao_p01_p20_generated1.F90
+ src/gencode/vaao_p01_p20_generated2.F90
+ src/gencode/vaao_p01_m20_generated1.F90
+ src/gencode/vaao_p01_m20_generated2.F90
+ src/gencode/vaao_p01_m20_generated3.F90
+ src/gencode/vaao_p01_m20_generated4.F90
+ src/gencode/vaao_p11_p12_generated1.F90
+ src/gencode/vaao_p11_p12_generated2.F90
+ src/gencode/vaao_p11_m11_generated1.F90
+ src/gencode/vaao_p11_m11_generated2.F90
+ src/gencode/vaao_p12_m12_generated1.F90
+ src/gencode/vaao_p12_m12_generated2.F90
+ src/gencode/vaao_p12_m12_generated3.F90
+ src/gencode/vaao_p12_m12_generated4.F90
+ src/gencode/vaao_m11_m12_generated1.F90
+ src/gencode/vaao_m11_m12_generated2.F90
+ src/gencode/vaao_m11_m12_generated3.F90
+ src/gencode/vaao_m11_m12_generated4.F90
+ src/gencode/vvaa_p01_p01_generated1.F90
+ src/gencode/vvaa_p01_p01_generated2.F90
+ src/gencode/vvaa_p02_p02_generated1.F90
+ src/gencode/vvaa_p02_p02_generated2.F90
+ src/gencode/vvaa_p02_p02_generated3.F90
+ src/gencode/vvaa_p02_p02_generated4.F90
+ src/gencode/vvaa_p12_p12_generated1.F90
+ src/gencode/vvaa_p12_p12_generated2.F90
+ src/gencode/vvaa_m11_m11_generated1.F90
+ src/gencode/vvaa_m11_m11_generated2.F90
+ src/gencode/vvaa_m12_m12_generated1.F90
+ src/gencode/vvaa_m12_m12_generated2.F90
+ src/gencode/vvaa_m12_m12_generated3.F90
+ src/gencode/vvaa_m12_m12_generated4.F90
+ src/gencode/vvaa_m20_m20_generated1.F90
+ src/gencode/vvaa_m20_m20_generated2.F90
+ src/gencode/vvaa_m20_m20_generated3.F90
+ src/gencode/vvaa_m20_m20_generated4.F90
+ src/gencode/vaoo_p01_p11_generated1.F90
+ src/gencode/vaoo_p01_p11_generated2.F90
+ src/gencode/vaoo_p01_m12_generated1.F90
+ src/gencode/vaoo_p01_m12_generated2.F90
+ src/gencode/vaoo_p01_m12_generated3.F90
+ src/gencode/vaoo_p01_m12_generated4.F90
+ src/gencode/vaoo_p02_p12_generated1.F90
+ src/gencode/vaoo_p02_p12_generated2.F90
+ src/gencode/vaoo_p02_p12_generated3.F90
+ src/gencode/vaoo_p02_p12_generated4.F90
+ src/gencode/vaoo_p12_p20_generated1.F90
+ src/gencode/vaoo_p12_p20_generated2.F90
+ src/gencode/vvao_p01_p12_generated1.F90
+ src/gencode/vvao_p01_p12_generated2.F90
+ src/gencode/vvao_p01_m11_generated1.F90
+ src/gencode/vvao_p01_m11_generated2.F90
+ src/gencode/vvao_p02_m12_generated1.F90
+ src/gencode/vvao_p02_m12_generated2.F90
+ src/gencode/vvao_p02_m12_generated3.F90
+ src/gencode/vvao_p02_m12_generated4.F90
+ src/gencode/vvao_m12_m20_generated1.F90
+ src/gencode/vvao_m12_m20_generated2.F90
+ src/gencode/vvao_m12_m20_generated3.F90
+ src/gencode/vvao_m12_m20_generated4.F90
+ src/gencode/vvoo_p01_p01_generated1.F90
+ src/gencode/vvoo_p01_p01_generated2.F90
+ src/gencode/vvoo_p02_p02_generated1.F90
+ src/gencode/vvoo_p02_p02_generated2.F90
+ src/gencode/vvoo_p02_p02_generated3.F90
+ src/gencode/vvoo_p02_p02_generated4.F90
+ src/gencode/vvoo_p12_p12_generated1.F90
+ src/gencode/vvoo_p12_p12_generated2.F90
+ src/gencode/vvoo_m12_m12_generated1.F90
+ src/gencode/vvoo_m12_m12_generated2.F90
+ src/gencode/vvoo_m12_m12_generated3.F90
+ src/gencode/vvoo_m12_m12_generated4.F90
+ src/gencode/vava_000_m20_generated1.F90
+ src/gencode/vava_000_m20_generated2.F90
+ src/gencode/vava_000_m20_generated3.F90
+ src/gencode/vava_000_m20_generated4.F90
+ src/gencode/vava_p02_p20_generated1.F90
+ src/gencode/vava_p02_p20_generated2.F90
+ src/gencode/vava_p02_p20_generated3.F90
+ src/gencode/vava_p02_p20_generated4.F90
+ src/gencode/vava_p11_m12_generated1.F90
+ src/gencode/vava_p11_m12_generated2.F90
+ src/gencode/vava_p11_m12_generated3.F90
+ src/gencode/vava_p11_m12_generated4.F90
+ src/gencode/vvvo_p01_p02_generated1.F90
+ src/gencode/vvvo_p01_p02_generated2.F90
+ src/gencode/vvvo_p01_p02_generated3.F90
+ src/gencode/vvvo_p01_p02_generated4.F90
+ src/gencode/vvvo_m11_m12_generated1.F90
+ src/gencode/vvvo_m11_m12_generated2.F90
+ src/gencode/vvvo_m11_m12_generated3.F90
+ src/gencode/vvvo_m11_m12_generated4.F90
+ src/gencode/vvva_p01_m12_generated1.F90
+ src/gencode/vvva_p01_m12_generated2.F90
+ src/gencode/vvva_p01_m12_generated3.F90
+ src/gencode/vvva_p01_m12_generated4.F90
+ src/gencode/vvva_p02_p12_generated1.F90
+ src/gencode/vvva_p02_p12_generated2.F90
+ src/gencode/vvva_p02_p12_generated3.F90
+ src/gencode/vvva_p02_p12_generated4.F90
+ src/gencode/vvva_m11_m20_generated1.F90
+ src/gencode/vvva_m11_m20_generated2.F90
+ src/gencode/vvva_m11_m20_generated3.F90
+ src/gencode/vvva_m11_m20_generated4.F90
+ src/gencode/vvvv_p02_p02_generated1.F90
+ src/gencode/vvvv_p02_p02_generated2.F90
+ src/gencode/vvvv_p02_p02_generated3.F90
+ src/gencode/vvvv_p02_p02_generated4.F90
+ src/gencode/vvvv_m12_m12_generated1.F90
+ src/gencode/vvvv_m12_m12_generated2.F90
+ src/gencode/vvvv_m12_m12_generated3.F90
+ src/gencode/vvvv_m12_m12_generated4.F90
+ src/gencode/vvvv_m20_m20_generated1.F90
+ src/gencode/vvvv_m20_m20_generated2.F90
+ src/gencode/vvvv_m20_m20_generated3.F90
+ src/gencode/vvvv_m20_m20_generated4.F90
+ src/gencode/oooo_p02_p02_generated1.F90
+ src/gencode/oooo_p02_p02_generated2.F90
+ src/gencode/oooo_p02_p02_generated3.F90
+ src/gencode/oooo_p02_p02_generated4.F90
+ src/gencode/oooo_p12_p12_generated1.F90
+ src/gencode/oooo_p12_p12_generated2.F90
+ src/gencode/oooo_p20_p20_generated.F90
+ src/gencode/vovo_000_p02_generated1.F90
+ src/gencode/vovo_000_p02_generated2.F90
+ src/gencode/vovo_000_p02_generated3.F90
+ src/gencode/vovo_000_p02_generated4.F90
+ src/gencode/aooo_p01_p12_generated1.F90
+ src/gencode/aooo_p01_p12_generated2.F90
+ src/gencode/aooo_p02_m12_generated1.F90
+ src/gencode/aooo_p02_m12_generated2.F90
+ src/gencode/aooo_p02_m12_generated3.F90
+ src/gencode/aooo_p02_m12_generated4.F90
+ src/gencode/aooo_p11_p20_generated.F90
+ src/gencode/vavo_000_m12_generated1.F90
+ src/gencode/vavo_000_m12_generated2.F90
+ src/gencode/vavo_000_m12_generated3.F90
+ src/gencode/vavo_000_m12_generated4.F90
+ src/gencode/vavo_p02_p11_generated1.F90
+ src/gencode/vavo_p02_p11_generated2.F90
+ src/gencode/vavo_p02_p11_generated3.F90
+ src/gencode/vavo_p02_p11_generated4.F90
+ src/gencode/vooo_p01_p02_generated1.F90
+ src/gencode/vooo_p01_p02_generated2.F90
+ src/gencode/vooo_p01_p02_generated3.F90
+ src/gencode/vooo_p01_p02_generated4.F90
+ src/gencode/vooo_p11_p12_generated1.F90
+ src/gencode/vooo_p11_p12_generated2.F90
+ src/gencode/aoao_000_p20_generated.F90
+ src/gencode/aoao_p02_m20_generated1.F90
+ src/gencode/aoao_p02_m20_generated2.F90
+ src/gencode/aoao_p02_m20_generated3.F90
+ src/gencode/aoao_p02_m20_generated4.F90
+ src/gencode/aoao_p12_m11_generated1.F90
+ src/gencode/aoao_p12_m11_generated2.F90
+ src/gencode/voao_000_p12_generated1.F90
+ src/gencode/voao_000_p12_generated2.F90
+ src/gencode/voao_p02_m11_generated1.F90
+ src/gencode/voao_p02_m11_generated2.F90
+ src/gencode/voao_p02_m11_generated3.F90
+ src/gencode/voao_p02_m11_generated4.F90
+)
diff --git a/cmake/RelaxSE_prop.cmake b/cmake/RelaxSE_prop.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..71bbc0b72f6bbbcec3c47e2173e4e7888b72422a
--- /dev/null
+++ b/cmake/RelaxSE_prop.cmake
@@ -0,0 +1,7 @@
+set(RELAXSE_SOURCES_prop
+ src/proprietes.F90
+ src/lect_data_prop.F90
+ src/def_files_prop.F90
+ src/init_prop.F90
+ src/info_prop.F90
+ )
diff --git a/cmake/Test_Sources.cmake b/cmake/Test_Sources.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..9eeca9c97120d06fbe9111e1c4690f93f87d103c
--- /dev/null
+++ b/cmake/Test_Sources.cmake
@@ -0,0 +1,13 @@
+set(UNITTEST_SOURCES
+ test/vector.f90
+ test/test_connect.f90
+ test/detact_test.f90
+ test/deter_test.f90
+ test/diag_test.f90
+ test/gener_ref.f90
+ test/gener_ref2.f90
+ test/gener_ref11211.f90
+ test/gener_ref11211_uu.f90
+ test/gener_ref44422.f90
+ test/hole_part_cases_test.f90
+ )
diff --git a/cmake/TestsRelaxSE.cmake b/cmake/TestsRelaxSE.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..64ccc18a50b3b4625fc693fbaf90875ad400fd99
--- /dev/null
+++ b/cmake/TestsRelaxSE.cmake
@@ -0,0 +1,66 @@
+#Run through each source
+foreach(testSrc ${UNITTEST_SOURCES})
+ #Extract the filename without an extension (NAME_WE)
+ get_filename_component(testName ${testSrc} NAME_WE)
+
+ #Add compile target
+ add_executable(${testName} ${testSrc})
+
+ #link to Boost libraries AND your targets and dependencies
+ target_link_libraries(${testName}
+ RelaxSE_lib
+ RelaxSE_type
+ RelaxSE_IO
+ RelaxSE_common
+ #test_utils
+ ${LAPACK_LIBRARIES}
+ ${BLAS_LIBRARIES})
+
+ #I like to move testing binaries into a testBin directory
+ set_target_properties(${testName} PROPERTIES
+ RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/testBin)
+
+ #Finally add it to test execution -
+ #Notice the WORKING_DIRECTORY and COMMAND
+ add_test(NAME ${testName}
+ WORKING_DIRECTORY ${CMAKE_BINARY_DIR}/testBin
+ COMMAND ${CMAKE_BINARY_DIR}/testBin/${testName} )
+endforeach(testSrc)
+
+macro(add_runtest _name)
+ add_test(
+ NAME ${_name}
+ COMMAND python3 ${CMAKE_SOURCE_DIR}/test/${_name}/test --binary-dir=${CMAKE_BINARY_DIR} --work-dir=${CMAKE_BINARY_DIR}/test/${_name} --verbose --log=${CMAKE_BINARY_DIR}/test/${_name}/runtest.stderr.log)
+ #if(NOT "${_labels}" STREQUAL "")
+ set_tests_properties(${_name} PROPERTIES
+ RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/test/${_name})
+ #endif()
+endmacro()
+add_runtest(CuO_20204)
+add_runtest(CuO_20204_spin)
+add_runtest(CuO_20240)
+add_runtest(CuO_02204)
+add_runtest(CuO_00800_HS)
+add_runtest(CuO_00800_LS)
+if(NOT ENABLE_NOGEN)
+ add_runtest(CuO_02240)
+ add_runtest(CuO_30405)
+ add_runtest(CuO_03450_nodet2)
+ add_runtest(CuO_03450_nodet3)
+ add_runtest(CuO_03450_nocontraction)
+ add_runtest(CuO_03450_allcontraction)
+ add_runtest(CuO_03450)
+ add_runtest(CuO_12423)
+ add_runtest(CuO_CAS+S)
+ add_runtest(CuO_DDCI)
+ add_test(NAME prop
+ WORKING_DIRECTORY ${CMAKE_BINARY_DIR}/test/CuO_DDCI
+ COMMAND ${CMAKE_BINARY_DIR}/prop.x )
+endif()
+
+if(ENABLE_MPI)
+ add_runtest(CuO_03450_bigbatch_MPIload)
+ add_runtest(CuO_03450_bigbatch_noMPIload)
+ add_runtest(CuO_03450_smallbatch_MPIload)
+ add_runtest(CuO_03450_smallbatch_noMPIload)
+endif()
diff --git a/configure b/configure
new file mode 100755
index 0000000000000000000000000000000000000000..d94e70001813a6e888809cc8655dd80205451143
--- /dev/null
+++ b/configure
@@ -0,0 +1,238 @@
+#!/usr/bin/env python3
+
+import os
+import sys
+import string
+import re
+import subprocess
+import shutil
+import datetime
+from argparse import ArgumentParser
+
+sys.path.append('cmake')
+
+if sys.version < '3.4':
+ print('requires python version >= 3.4')
+ print('current version',sys.version)
+ sys.exit(1)
+
+root_directory = os.path.dirname(os.path.realpath(__file__))
+default_path = os.path.join(root_directory, 'build')
+src_path = os.path.join(root_directory, 'src')
+
+def parse_input():
+ '''
+ Parse input
+ here only the build directory is given but could be extended
+ '''
+ parser = ArgumentParser(description="setup build configurations")
+
+ parser.add_argument('builddir', nargs='?',
+ action='store',
+ default=default_path,
+ help='build directory [default: %(default)s]',
+ metavar='build path')
+
+ # Basic compiler options
+ group = parser.add_argument_group('basic options')
+ group.add_argument('--fc',
+ action='store',
+ default=None,
+ help='set the Fortran compiler [default: pick automatically or based on FC=...]',
+ metavar='STRING')
+ group.add_argument('--cc',
+ action='store',
+ default=None,
+ help='set the C compiler [default: pick automatically or based on CC=...]',
+ metavar='STRING')
+ group.add_argument('--cxx',
+ action='store',
+ default=None,
+ help='set the C++ compiler [default: pick automatically or based on CXX=...]',
+ metavar='STRING')
+
+ group.add_argument('--gnu',
+ action='store_true',
+ default=False,
+ help='select the gnu compilers')
+
+ group.add_argument('--intel',
+ action='store_true',
+ default=False,
+ help='select the intel compilers')
+
+ group.add_argument('--show',
+ action='store_true',
+ default=False,
+ help='show cmake command and exit [default: %(default)s]')
+
+ group.add_argument('--cmake',
+ action='store',
+ default='cmake',
+ help='set the cmake command [default: cmake; e.g. --cmake cmake28]',
+ metavar='STRING')
+
+ # Build type (release, debug or profiling)
+
+ group = parser.add_argument_group('release, debug, opt or profile')
+ group.add_argument('--build-type',
+ action='store',
+ default='Release',
+ help='build type (Opt, Release, Debug, or Profile) [default: %(default)s]',
+ metavar='STRING')
+ group.add_argument('--nogen',
+ action='store_true',
+ default=False,
+ help='disable generated code [default: %(default)s]')
+
+ group = parser.add_argument_group('parallelization')
+ group.add_argument('--mpi',
+ action='store_true',
+ default=False,
+ help='enable MPI [default: %(default)s]')
+ group.add_argument('--omp',
+ action='store_true',
+ default=False,
+ help='enable OpenMP [default: %(default)s]')
+
+
+ return parser.parse_args()
+
+def check_cmake_exists(cmake_command):
+ p = subprocess.Popen('%s --version' % cmake_command,
+ shell=True,
+ stdin=subprocess.PIPE,
+ stdout=subprocess.PIPE,
+ universal_newlines=True)
+ if not ('cmake version' in p.communicate()[0]):
+ print(' This code is built using CMake')
+ print('')
+ print(' CMake is not found')
+ print(' 1) on some clusters CMake is installed')
+ print(' but you have to load it first:')
+ print(' $ module load cmake')
+ print(' 2) if not, get CMake at http://www.cmake.org/')
+ sys.exit()
+
+def translate_cmake(s):
+ if s:
+ return 'ON'
+ else:
+ return 'OFF'
+
+def gen_cmake_command(args):
+ # create cmake command from flags
+
+ command = ''
+
+ if args.fc:
+ command += ' FC=%s' % args.fc
+ if args.cc:
+ command += ' CC=%s' % args.cc
+ if args.cxx:
+ command += ' CXX=%s' % args.cxx
+
+ if args.gnu:
+ if args.mpi:
+ # command += ' -DCMAKE_C_COMPILER=`which gcc` -DCMAKE_CXX_COMPILER=`which g++` -DCMAKE_Fortran_COMPILER=`which gfortran`'
+ command += ' CC=`which gcc` CXX=`which g++` FC=`which gfortran`'
+ else:
+ command += ' CC=`which gcc` CXX=`which g++` FC=`which gfortran`'
+
+ if args.intel:
+ if args.mpi:
+ command += ' CC=`which icc` CXX=`which icpc` FC=`which ifort`'
+ else:
+ command += ' CC=`which icc` CXX=`which icpc` FC=`which ifort`'
+
+ command += ' %s' % args.cmake
+
+ if args.intel:
+ if args.mpi:
+ command += ' -DMPI_C_COMPILER=`which mpiicc` -DMPI_CXX_COMPILER=`which mpiicpc` -DMPI_Fortran_COMPILER=`which mpiifort`'
+
+ command += ' -DENABLE_MPI=%s' % translate_cmake(args.mpi)
+ command += ' -DENABLE_OMP=%s' % translate_cmake(args.omp)
+ command += ' -DENABLE_NOGEN=%s' % translate_cmake(args.nogen)
+
+ if args.build_type:
+ command += ' -DCMAKE_BUILD_TYPE=%s' % args.build_type
+
+ command += ' %s' % root_directory
+
+ print('%s\n' % command)
+ if args.show:
+ sys.exit()
+ return command
+
+def print_build_help(build_path):
+ print(' configure step is done')
+ print(' now you need to compile the sources:')
+ if (build_path == default_path):
+ print(' $ cd build')
+ else:
+ print(' $ cd ' + build_path)
+ print(' $ make')
+
+def save_setup_command(argv, command, build_path):
+ file_name = os.path.join(build_path, 'setup_command')
+ f = open(file_name, 'w')
+ f.write('# setup command was executed '+datetime.datetime.now().strftime("%d-%B-%Y %H:%M:%S"+"\n"))
+ f.write(" ".join(argv[:])+"\n")
+ f.write("\n# cmake command generated by this setup command was: \n")
+ f.write("# "+command+"\n")
+ f.close()
+
+
+def setup_build_path(build_path):
+ if os.path.isdir(build_path):
+ fname = os.path.join(build_path, 'CMakeCache.txt')
+ if os.path.exists(fname):
+ print('aborting setup - build directory %s which contains CMakeCache.txt exists already' % build_path)
+ print('remove the build directory and then rerun setup')
+ sys.exit(1)
+ else:
+ #shutil.copytree(src_path, build_path)
+ os.makedirs(build_path, mode = 0o755)
+
+def run_cmake(command, build_path):
+ topdir = os.getcwd()
+ os.chdir(build_path)
+ p = subprocess.Popen(command,
+ shell=True,
+ stdin=subprocess.PIPE,
+ stdout=subprocess.PIPE,
+ universal_newlines=True)
+ s = p.communicate()[0]
+ # print cmake output to screen
+ print(s)
+ # write cmake output to file
+ f = open('setup_cmake_output', 'w')
+ f.write(s)
+ f.close()
+ # change directory and return
+ os.chdir(topdir)
+ return s
+
+
+def main(argv):
+ print("Running configure")
+ args = parse_input()
+ check_cmake_exists(args.cmake)
+ build_path = args.builddir
+ print("Build directory:" + args.builddir)
+ if not args.show:
+ setup_build_path(build_path)
+ command = gen_cmake_command(args)
+ status = run_cmake(command, build_path)
+
+ if 'Configuring incomplete' in status:
+ print("Configure incomplete")
+
+ else:
+ # configuration was successful
+ save_setup_command(argv, command, build_path)
+ print_build_help(build_path)
+
+if __name__ == '__main__':
+ main(sys.argv)
diff --git a/src/RelaxSE.F90 b/src/RelaxSE.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e87b99bd0780dcd30ef9401def89377e981d3d09
--- /dev/null
+++ b/src/RelaxSE.F90
@@ -0,0 +1,469 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+!> @file Main for the RelaxSE program
+!> @author Marie-Bernadette Lepetit and Elisa Rebolini
+
+Program RelaxSE
+
+
+!!$ -------- Donness globales ---------------------------------
+ use info
+ use detact
+ use spindetact
+ use gener_ref0
+ use gener_ref1
+ use gener_monos
+ use fockmatrix
+ use gener_guess
+ use integrales
+ use SASS_diag
+ use hole_part_cases
+ use explicit_Hmat
+ use utils_wrt
+
+#ifndef VAR_NOGEN
+ use codegen_hdiag
+#endif
+
+!!$ -------- Donnes locales -----------------------------------
+ implicit none
+
+ type(g_infotype) :: g_info
+ type(prog_infotype) :: prog_info
+ type(o_infotype) :: o_info
+ type(ord_infotype) :: ord_info
+ type(v_infotype) :: v_info
+ type(det_infotype) :: det_info
+ type(ener_infotype) :: ener_info
+ type(int_infotype) :: int_info
+ type(david_infotype):: bdav_info
+ type(sym_infotype) :: sym_info
+
+ type(deter), dimension(:), allocatable :: ref0, det
+
+ Real (KIND=kd_dble), dimension(:), allocatable :: Hdiag
+ Real (KIND=kd_dble), dimension(:,:), allocatable :: fock, hcoeur, h0, Hmat
+ Real (KIND=kd_dble), dimension(:,:), allocatable :: psi_0_guess, psi_SASS
+
+ type(case_infotype), allocatable :: hole_case_info(:), part_case_info(:)
+
+ type(rlist) :: r
+ type(spinrlist) :: rspin
+ integer, parameter :: nb_rlist = 9
+ type(spindetact_list), pointer :: r0
+ type(deter_dblocklist) :: d
+
+ real(kd_dble) :: hij_test
+
+ Integer (KIND=kd_int) :: nvec_restart, nd00
+ Integer (KIND=kd_int) :: i, j, idet, jdet
+ real(kd_dble) :: tstart, tend, t1, t2, wstart, wend, wstart1, wend1
+
+ CHARACTER(LEN=8) :: date ! returned values from DATE_AND_TIME()
+ CHARACTER(LEN=10) :: time
+ CHARACTER(LEN=5) :: zone
+ INTEGER,DIMENSION(8) :: values
+
+ integer :: nb_thread
+
+ logical :: lprop
+
+#ifdef VAR_MPI
+ integer :: ierr
+
+ call mpi_init(ierr)
+#endif
+
+ call gettime(tstart, wstart)
+
+!!$============================================================
+!!$ -------- Code ---------------------------------------------
+!!$-----
+!!$----- Initialisations
+!!$-----
+ ! Initialisations des variables
+
+ call init(g_info, prog_info, o_info, v_info, &
+ det_info, ener_info, int_info, bdav_info, sym_info)
+
+ prog_info%tstart = tstart
+ prog_info%wstart = wstart
+
+#ifdef VAR_MPI
+ !Get the nb of CPUs and the rank of the current one
+ call mpi_comm_size(MPI_COMM_WORLD, prog_info%nb_cpu, ierr)
+ call mpi_comm_rank(MPI_COMM_WORLD, prog_info%id_cpu, ierr)
+#endif
+
+#ifdef VAR_OMP
+ !$OMP PARALLEL SHARED(nb_thread)
+ nb_thread=OMP_GET_MAX_THREADS()
+ !$OMP END PARALLEL
+
+ prog_info%nb_thread = nb_thread
+#endif
+
+ !Definition des fichiers
+ call def_files(prog_info)
+
+ ! Lectures infos MOLCAS + donnees SASS
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*) ("--", i=1,50)
+ write(f_output,*)">>> Reading input data"
+ write(f_output,*) ("--", i=1,50)
+ endif
+ call lect_data(g_info, prog_info, o_info, v_info, det_info, &
+ ener_info, bdav_info, sym_info)
+ if (prog_info%id_cpu.eq.0) then
+ flush(f_output)
+ endif
+
+
+ ! Calcul de tableurs d'ordre des orbitales Molcas <-> SASS
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*) ("--", i=1,50)
+ write(f_output,*)">>> Preparations "
+ write(f_output,*) ("--", i=1,50)
+ write(f_output,*)">>> Orbital re-ordering Molcas <-> RelaxSE"
+ flush(f_output)
+ end if
+ call orb_ordering(prog_info, ord_info, o_info, g_info)
+ if (prog_info%id_cpu.eq.0) flush(f_output)
+
+ ! Lecture des ref0
+ if (prog_info%id_cpu.eq.0) then
+ if (prog_info%methodAct.eq.'cas') then
+ write(f_output,*)
+ write(f_output,*)">>> Ref0 = CAS"
+ else
+ write(f_output,*)
+ write(f_output,*)">>> Reading Ref0"
+ write(f_output,'(a25,":",i4)') " Nb of read ref0 ",&
+ det_info%nref0
+ end if
+ end if
+
+
+ ! Initialisation ref0 and active determinant lists R
+ if (prog_info%methodAct.eq.'cas') then
+ det_info%nref0 = comb(o_info%nact,g_info%na) * comb(o_info%nact,g_info%nb)
+ call deter_init(ref0, det_info%nref0)
+ call gener_cas(ref0, prog_info, det_info, g_info, o_info)
+ else
+ call deter_init(ref0, det_info%nref0)
+ call lect_ref0(ref0, prog_info, det_info, g_info, o_info, v_info)
+ end if
+ if (prog_info%id_cpu.eq.0) flush(f_output)
+
+
+ call detact_all_init(r, nb_rlist)
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*)">>> Generation of all determinants"
+ flush(f_output)
+ endif
+ call gettime(t1,wstart1)
+ ! Calcul des conf de spin des ref0
+ call generspin_ref0(ref0, vecref0, r, o_info, det_info, v_info, prog_info)
+ ! Calcul des conf de spin des ref1
+ call generspin_ref1(ref0, r, o_info, det_info, g_info%nelact, prog_info)
+ call deter_free(ref0)
+
+ !If this is the first time that the calculation is launched then write the dets
+ !are saved for the prop.x otherwise this is not needed.
+ lprop = .false.
+ if (.not. prog_info%restart) then
+ if (prog_info%id_cpu.eq.0) then
+ lprop = .true.
+ endif
+ endif
+
+ ! Generation of all active determinants
+ call compute_all_spindetact(rspin, r, o_info, v_info%sz)
+ ! Generation of all determinants
+ call deter_blocklist_init(d)
+ call generspin_det(det_info, rspin, d, o_info, v_info, prog_info, lprop)
+ call gettime(t2,wend1)
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) '>>>Determinants generated in',t2-t1,'second(s)'
+ flush(f_output)
+ endif
+
+ if (lprop) then
+ write(f_output,*)
+ call wrt_info(prog_info,g_info,o_info,v_info,det_info,d,sym_info,f_info)
+ write(f_output,*)">>> x_info written on file"
+ flush(f_info)
+ flush(f_output)
+ write(f_output,*)
+ call deter_init(det,det_info%ndet)
+ call fill_detd(det, d)
+ call wrt_bdet(det,det_info%ndet,f_bdet)
+ write(f_output,*)">>> Determinants written on file"
+ flush(f_output)
+ flush(f_bdet)
+ call deter_free(det)
+ endif
+
+ !Initialisation of the bare h matrix
+ ! contains ntot * ntot elements
+ ! their indices run from ngel+1 to ngel+ntot
+ allocate(hcoeur(o_info%ngel+1: o_info%ngel+o_info%ntot, &
+ o_info%ngel+1 : o_info%ngel+o_info%ntot))
+ hcoeur(:,:) = 0.d0
+
+ ! Lecture des integrales
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*)">>> Lecture des integrales TraOne et TraInt"
+ flush(f_output)
+ endif
+ call gettime(t1,wstart1)
+ call lect_int(hcoeur, g_info, prog_info, o_info, ord_info, ener_info, &
+ int_info, f_output)
+ call gettime(t2,wend1)
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) '>>> Integrals read in',t2-t1,'second(s)'
+ flush(f_output)
+ endif
+
+#ifdef VAR_MPI
+ call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+#endif
+
+ !Build the fock matrix
+ !Add the 2e- part to the bare h_pq
+ !f_pq = h_pq + sum[ 2(ij|oo) - (io|jo)]
+ !where o runs on both the occ and ligo
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*)">>> Construction of the Fock matrix"
+ endif
+
+ call gettime(t1,wstart1)
+ allocate(fock(o_info%ngel+1 : o_info%ngel+o_info%ntot, &
+ o_info%ngel+1 : o_info%ngel+o_info%ntot))
+ fock(:,:) = 0.d0
+ call build_fock(fock, hcoeur, o_info, int_info, prog_info)
+ !call diag_fock(fock, o_info)
+ call gettime(t2,wend1)
+
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) '>>> Fock matrix built in',t2-t1,'second(s)'
+ write(f_output,*)
+ flush(f_output)
+ endif
+ call get_e0(ener_info, hcoeur, o_info, int_info, prog_info)
+
+!-----
+!----- Diag 0
+!-----
+
+ allocate(hdiag(det_info%ndet))
+#ifdef VAR_NOGEN
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*) &
+ ">>> Construction of the diagonal of the Hamiltonian matrix"
+ flush(f_output)
+ call gettime(t1,wstart1)
+ endif
+ call build_hdiag(hdiag, rspin, d, hcoeur, fock, o_info, int_info, &
+ ener_info%ecoeur, g_info%nelact, v_info%sz, prog_info)
+ if (prog_info%id_cpu.eq.0) then
+ call gettime(t2,wend1)
+ write(f_output,'(X,A,F12.6,A)',advance='no') &
+ '>>> Hdiag built in CPU time:',t2-t1,' second(s)'
+ write(f_output,'(X,A,F12.6,A)')' Wall time:', &
+ wend1-wstart1,' second(s)'
+ flush(f_output)
+ endif
+#else
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*) &
+ ">>> Construction of the diagonal of the Hamiltonian matrix (gen)"
+ call gettime(t1,wstart1)
+ endif
+ call build_hdiag_gen(hdiag, rspin, d, fock, o_info, int_info, &
+ g_info%nelact, prog_info)
+ if (prog_info%id_cpu.eq.0) then
+ call gettime(t2,wend1)
+ write(f_output,'(X,A,F12.6,A)',advance='no') &
+ '>>> Hdiag(gen) built in CPU time:',t2-t1,' second(s)'
+ write(f_output,'(X,A,F12.6,A)')' Wall time:', &
+ wend1-wstart1,' second(s)'
+ flush(f_output)
+ endif
+#endif
+ deallocate(hcoeur)
+
+
+
+ !Compute the D00-D00 block to find a good guess or restart from previous calc.
+ if (.not. prog_info%restart) then
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*) ("--", i=1,50)
+ write(f_output,*) '>>> Calculation of guess vectors'
+ write(f_output,*) ("--", i=1,50)
+ write(f_output,*) '>>> Build the matrix H0=<D00|H|D00>'
+ call gettime(t1,wstart1)
+ flush(f_output)
+ endif
+ r0 => rspin%l(1)%p
+ call compute_h0(h0, r0, d, fock, hdiag, g_info, o_info, ord_info, &
+ int_info, v_info%sz, prog_info)
+ nd00 = d%detblock(1)%p%ndet
+ call diag_h0(h0, psi_0_guess, nd00, ener_info, v_info%nvec, prog_info)
+
+ if (prog_info%id_cpu.eq.0) then
+ call gettime(t2,wend1)
+ write(f_output,*) '>>> H0 diagonalised in',t2-t1,'second(s)'
+ flush(f_output)
+ endif
+ deallocate(h0)
+ else
+ r0 => rspin%l(1)%p
+ call lect_guess(psi_0_guess, det_info%ndet, v_info%nvec, nvec_restart, &
+ bdav_info%iter0, ener_info%potnuc, ener_info%Ecoeur)
+ if (nvec_restart.lt.v_info%nvec) &
+ call complement_guess(psi_0_guess, det_info%ndet, v_info%nvec, nvec_restart, r0, d, &
+ fock, hdiag, g_info, o_info, ord_info, int_info, v_info%sz, ener_info, prog_info)
+ end if
+
+
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*) ("--", i=1,50)
+ write(f_output,*) '>>> Diagonalisation'
+ write(f_output,*) ("--", i=1,50)
+ flush(f_output)
+ endif
+
+ if (prog_info%lexplicit) then
+ call generspin_det(det_info, rspin, d, o_info, v_info, prog_info, .true.)
+ call deter_init(det,det_info%ndet)
+ call fill_detd(det, d)
+
+ if (prog_info%lreadHmat) then
+ call read_hmat_from_file(Hmat, det_info%ndet, v_info%nvec, prog_info)
+ endif
+
+ open(60)
+ open(61)
+ do idet = 1, det_info%ndet
+ do jdet = 1, det_info%ndet
+ hij_test = explicit_Hij(&
+ Idet, Jdet,&
+ det, fock, hdiag, g_info, prog_info, &
+ o_info, int_info, v_info, ener_info, 60)
+ if (prog_info%lreadHmat) then
+ write(61,*) idet, jdet, hij_test, Hmat(idet,jdet), Hij_test-Hmat(idet,jdet)
+ else
+ write(61,*) idet,jdet,Hij_test
+ endif
+ flush(60)
+ flush(61)
+ enddo
+ enddo
+ close(61)
+ close(60)
+ call deter_free(det)
+ if (prog_info%lreadHmat) then
+ deallocate(Hmat)
+ endif
+ else
+
+ !-----
+ !----- Diag SAS+S
+ !-----
+
+ allocate(hole_case_info(num_cases))
+ allocate(part_case_info(num_cases))
+ call gener_hole_case_info(hole_case_info)
+ call gener_part_case_info(part_case_info, g_info%nelact)
+
+ allocate(psi_SASS(det_info%ndet, v_info%nvec))
+ call diag_sass(psi_0_guess, psi_SASS, fock, hdiag, rspin, d, &
+ prog_info, o_info, int_info, v_info, g_info%nelact, det_info%ndet, &
+ hole_case_info, part_case_info, bdav_info, ener_info)
+ if ((prog_info%id_cpu.eq.0).and.(prog_info%iprint.eq.10)) then
+ call wrtmat(psi_SASS, det_info%ndet, det_info%ndet, v_info%nvec, f_output)
+ end if
+
+ deallocate(psi_SASS)
+ deallocate(hole_case_info)
+ deallocate(part_case_info)
+
+ endif
+ flush(f_output)
+
+!!$-----
+!!$----- Sorties
+!!$-----
+ call detact_all_free(r)
+ call spindetact_all_free(rspin)
+ call deter_blocklist_free(d)
+ deallocate(fock)
+ deallocate(hdiag)
+ deallocate(psi_0_guess)
+
+
+ deallocate(vecref0)
+ deallocate(orb_info)
+ call info_free(g_info, prog_info, o_info, ord_info, v_info, &
+ det_info, ener_info, int_info, bdav_info, sym_info)
+
+ call gettime(tend,wend)
+
+ if (prog_info%id_cpu.eq.0) then
+ call date_and_time(date, time, zone, values)
+ write(f_output,'(X,A,F17.2,A,F17.2,A)') 'Calculation finished in CPUtime',&
+ tend-tstart,'s Walltime:', &
+ wend-wstart,'s'
+
+ write(f_output,*) 'Calculation finished on ', date(7:8),'-',date(5:6),&
+ '-',date(1:4), ' at ', time(1:2),':',time(3:4)
+ endif
+#ifdef VAR_MPI
+ call mpi_finalize(ierr)
+#endif
+ End Program RELAXSE
+
+
+
+!!$==========================================================================
+
+!!$ Local Variables:
+!!$ coding: utf-8-unix
+!!$ End:
diff --git a/src/RelaxSE_diag.F90 b/src/RelaxSE_diag.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5e0406166cedac1f2ad53c527bffbcfdf65d707b
--- /dev/null
+++ b/src/RelaxSE_diag.F90
@@ -0,0 +1,1358 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+
+module SASS_diag
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_ortho
+ use utils_intcase
+ use typetargetvec
+ use compute_hv
+ use sort
+
+ implicit none
+
+contains
+
+ !$========================================================================
+ !> @brief Iterative diagonalisation of the SASS
+ !> @author MB Lepetit
+ !> @date June 2018
+ !
+ !> @param psi in input Guess vectors coming from the exact diag
+ !> @param psi in output final vectors
+ !! of <D00|H|D00>
+ !> @param psi_SASS Target states
+ !> @param fock Fock matrix in the AO basis
+ !> @param hdiag Diagonal elms of the Hamiltonian matrix
+ !> @param rspin List of the spin-ordered active parts of the determinants
+ !> @param det List of blocks of determinants D_m^n
+ !> @param o_info Orbital information
+ !> @param int_info Integral information
+ !> @param v_info Info on the target states
+ !> @param nelact Nb of active electrons
+ !> @param ndet Total number of determinants
+ !$========================================================================
+ subroutine diag_sass(psi_0_guess, psi_SASS, fock, hdiag, rspin, det, prog_info, &
+ o_info, int_info, v_info, nelact, ndet, hcase_info, pcase_info, bdav_info, &
+ ener_info)
+!!$
+!!$ Vm(idet,ivec,icol) : vecteur correction du vecteur ivec
+!!$ du block icol sur le det idet
+!!$ Wm(idet,ivec,icol) : H*Vm
+!!$ H_dav : Hamiltonien effectif sur les vecteurs Vm
+!!$ H_dav(i,j) = Vm(i)*H*Vm(j)
+!!$
+
+ real(kd_dble), parameter :: mev=27211.386245988d0, epsilon=1.d-12, num_epsilon=1.d-15
+
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: psi_0_guess
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: psi_SASS
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ real(kd_dble), dimension(:), allocatable, intent(in) :: hdiag
+ type(spinrlist), intent(in) :: rspin
+ type(deter_dblocklist), intent(in) :: det
+ type(prog_infotype), intent(in) :: prog_info
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(v_infotype), intent(in) :: v_info
+ type(david_infotype), intent(in) :: bdav_info
+ type(ener_infotype), intent(inout) :: ener_info
+ integer, intent(in) :: nelact
+ integer, intent(in) :: ndet
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, nd00, sz, nvec
+ integer :: nconv, nvectot
+ integer :: Sizeheff, Dimheff, NitDavid, iter0
+ integer, dimension(:), allocatable :: vconv ! vecteurs convergés
+ real(kd_dble) :: Ecoeur, potnuc
+ real(kd_dble) :: tol_orth, tol_norm, tol_conv
+ real(kd_dble), dimension(:,:,:), allocatable :: Vm, Wm
+ real(kd_dble), dimension(:,:), allocatable :: S, Vect, H_dav, Hmat
+ real(kd_dble), dimension(:), allocatable :: ener
+ real(kd_dble), dimension(:), allocatable :: Ener_np1, deltaE, etmp
+
+#ifdef VAR_NOGEN
+ real(kd_dble), dimension(:), allocatable :: Emat
+ real(kd_dble), dimension(:,:), allocatable :: Vmat
+ integer :: info
+#endif
+
+ integer :: ivec, jvec, kvec, iter, ish, jsh, i, j
+ integer :: ncol, icol, jcol, idet
+
+ integer :: nguess
+ integer :: iconv, nbre_col
+ real(kd_dble) :: tmp, t1, ostart
+ logical :: clef, conv_ener
+
+ type(intkind_H), dimension(:), allocatable :: intkindlist
+ type(int_blockpair_list) :: mpilist
+ integer :: sizebatch
+
+ logical :: debugdav
+ integer :: fdav = 666 !file id for debugdav printing
+
+ debugdav = bdav_info%debug_dav
+ open(666)
+ open(667)
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ nd00 = det%detblock(1)%p%ndet
+ sz = v_info%sz
+ nvectot = v_info%nvec
+ Sizeheff = bdav_info%Sizeheff
+ NitDavid = bdav_info%NitDavid
+ tol_orth = bdav_info%tol_orth
+ tol_norm = bdav_info%tol_norm
+ tol_conv = bdav_info%tol_conv
+ conv_ener= bdav_info%conv_ener
+ iter0 = bdav_info%iter0
+ iter = 0
+ potnuc = ener_info%potnuc
+ Ecoeur = ener_info%Ecoeur
+
+#ifdef VAR_NOGEN
+ if (debug) then
+ allocate(Hmat(ndet,ndet))
+ endif
+#else
+ allocate(Hmat(1,1))
+#endif
+
+#ifdef VAR_MPI
+ sizebatch = prog_info%sizebatch
+#else
+ sizebatch = max(1,nligv+nvirt)
+#endif
+
+
+ call get_mpiblockpair_list(mpilist, sizebatch, nligv+nvirt)
+
+
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)
+ write(f_output,*)&
+ "================================================================="
+ write(f_output,*) ">>> Davidson Diagonalisation "
+ write(f_output,'(A,I0,A,ES8.1)') " Search for ",nvectot,&
+ " vectors with a convergence threshold of ",sqrt(tol_conv)
+ write(f_output,*)
+ call gettime(t1,ostart)
+ write(f_output,'(A,F12.4,A)') 'Total Elapsed tWall ', ostart-prog_info%wstart,'s'
+
+ write(f_output, '(A,I0,A)') 'Particles are divided in batches of ', sizebatch
+ endif
+
+ if (debugdav) then
+ write(fdav,*) "Guess vectors"
+ do idet = 1, nd00
+ write(fdav,*) (psi_0_guess(idet,ivec), ivec = 1,nvectot)
+ enddo
+ write(fdav,*)
+ end if
+
+!!$ allocations |Vm> et H|Vm> = |Wm> et initialisation des vecteurs
+ allocate(Vm(ndet, nvectot, Sizeheff))
+ allocate(Wm(ndet, nvectot, Sizeheff))
+
+ Vm(:,:,:) = 0.d0
+ Wm(:,:,:) = 0.d0
+ psi_SASS(:,:) = 0.d0
+ ! Initialisation de la première colonne de Heff
+ ! aux nvectot vecteurs d'essai donnés sur les nd00 premiers déterminants
+ if (prog_info%restart) then
+ nguess = ndet
+ else
+ nguess = nd00
+ endif
+ Vm(1:nguess,1:nvectot,1) = psi_0_guess(1:nguess,1:nvectot)
+ psi_SASS(1:nguess,1:nvectot) = psi_0_guess(1:nguess,1:nvectot)
+
+!!$ Orthogonormalite des vecteurs d'essai
+ call orthonorm(Vm(1,1,1),ndet,nvectot,tol_orth,tol_norm,.false.,prog_info)
+
+
+!!$ Davidson iterations ------------------------------------------------
+ ! Initialisations
+ Dimheff = nvectot*(Sizeheff +1) ! dimension Heff de Davidson
+
+ allocate(vect(Dimheff,Dimheff))
+ allocate(ener(nvectot))
+ allocate(ener_np1(Dimheff))
+ allocate(etmp(nvectot),deltaE(nvectot))
+ allocate(vconv(nvectot)) ! numéro des vecteurs convergés
+ allocate(H_dav(Dimheff,Dimheff))
+
+ H_dav(:,:) = 0.d0 ! Heff de Davidson
+ vect(:,:) = 0.d0 ! vecteurs pp de H_dav
+ ener(:) = 0.d0 ! valeurs pp H_dav
+ ener_np1(:) = 0.d0 ! valeurs pp H_dav iteration N+1
+ deltaE(:) = 0.d0 ! E(n)-E(n-1)
+ etmp(:) = 0.d0 ! energies temporaires
+ vconv(:) = 0
+
+ nconv = 0
+ ncol = 1
+ nvec = nvectot
+
+ !Fock and Integrals
+ call intkind_H_all_init(intkindlist, int_info)
+
+
+ if (prog_info%id_cpu.eq.0) then
+#ifdef VAR_MPI
+ write(f_output,'(X,A6,X,A12,X,A12,X,A12,2X,A)') &
+ '#Iter', 'tallCPU (s)', 'tCPU0 (s)', 'tWall0 (s)', "Energies"
+ write(*,*) '#tCPU (s) : tWall (s) : tCPU/tWall : intkind : DblockI : DblockJ : spin'
+#else
+ write(f_output,'(X,A6,X,A12,X,A12,2X,A)') '#Iter', 'tCPU (s)', 'tWall (s)', "Energies"
+ write(667,*) '#tCPU (s) : tWall (s) : tCPU/tWall : intkind : DblockI : DblockJ : spin'
+#endif
+ endif
+ !----------------------------------------------------------------------------------------------
+ daviter: do iter = 1, NitDavid !---------------------------------------------------------------
+
+ call david_iter(H_dav, ener, ener_np1, deltaE, vect, psi_SASS, &
+ Vm, Wm, Dimheff, ncol, fock, hdiag, rspin, &
+ det, o_info, int_info, v_info, prog_info, nelact, ndet, nvec, nconv, &
+ hcase_info, pcase_info, bdav_info, ener_info, Hmat, intkindlist, mpilist, iter)
+
+ if (prog_info%iprintHmat .gt. 0) goto 902
+
+ ! On teste la convergence sur les energies
+ if (conv_ener) then
+ tmp = 0.d0
+ if ((iter > 2).and.(ncol >1)) then
+ do ivec = 1,nvec
+ if (abs(Ener_np1(ivec)-Ener(ivec+nconv)).gt.tmp) &
+ tmp = abs(Ener_np1(ivec)-Ener(ivec+nconv))
+ end do
+ if (tmp.lt.tol_conv*tol_conv) then
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) " "
+ write(f_output,'(A,ES8.1,A)') " >>> Davidson procedure converged in energy at", &
+ tol_conv*tol_conv, " <<<"
+ endif
+ ! On met à jour Ener
+ Ener(1+nconv:nvectot) = Ener_np1(1:nvec)
+ nconv = nconv + nvec
+ goto 900 !convergence
+ end if
+ end if
+ end if
+
+ ! On met à jour Ener
+ Ener(1+nconv:nvectot) = Ener_np1(1:nvec)
+
+ ! Sauvegarde des vecteurs pour restart
+ rewind(f_restart)
+ write(f_restart) nvectot,ndet,nconv, iter+iter0
+ write(f_restart) Ecoeur,PotNuc
+ write(f_restart) (ener(ivec), ivec =1,nvectot)
+ do ivec = 1,nvectot
+ write(f_restart) (psi_SASS(idet,ivec),idet=1,ndet)
+ end do
+ flush(f_restart)
+
+ ! Si a on atteint Sizeheff alors on contracte tout sur les premiers vecteurs
+ ! (une colonne)
+ if (ncol.ge.Sizeheff) then
+ Vm(:,:,:) = 0.d0
+ Wm(:,:,:) = 0.d0
+ do ivec=1,nvec
+ Vm(1:ndet,ivec,1) = psi_SASS(1:ndet,ivec+nconv)
+ end do
+ ncol = 1
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) " >>> On contracte <<<"
+ endif
+ cycle
+ end if
+
+ ! Sinon Calcul du nouveau vecteur de correction : (HV-EV)/(Ej-Hii) -> Vm(ncol+1)
+ ncol = ncol + 1
+ if (debugdav) then
+ write(fdav,*) " vecteurs HV de l'iteration :", iter+iter0
+ call wrtmat(Wm, ndet, min(10,ndet), nvec*ncol, fdav)
+ write(fdav,*)
+ write(fdav,*) " vecteurs V de l'iteration :", iter+iter0
+ call wrtmat(Vm, ndet, min(10,ndet), nvec*ncol, fdav)
+ write(fdav,*)
+ write(fdav,*) " vecteurs vect de l'iteration :", iter+iter0
+ call wrtmat(vect, Dimheff, nvec*ncol, nvec*ncol, fdav)
+ write(fdav,*)
+ end if
+ Vm(:,:,ncol) = 0.d0
+ if (debugdav) write(fdav,*) " ncol =",ncol
+ do ivec = 1,nvec
+ do jcol = 1, ncol-1
+ jsh = (jcol-1)*nvec
+ do jvec = 1, nvec
+ Vm(1:ndet,ivec,ncol) = Vm(1:ndet,ivec,ncol) + &
+ Vect(jvec+jsh,ivec)*&
+ (Wm(1:ndet,jvec,jcol) - Ener_np1(ivec)*Vm(1:ndet,jvec,jcol))
+ end do
+ end do
+ if (debugdav) then
+ write(fdav,*) " vecteurs HV-EV de l'iteration :", iter+iter0, " vecteur ",ivec
+ call wrtmat(Vm(1,ivec,ncol), ndet, min(10,ndet), 1, fdav)
+ write(fdav,*)
+ end if
+ do idet = 1,ndet
+ if (abs(Ener_np1(ivec) - Hdiag(idet)).lt.epsilon) cycle
+ Vm(idet,ivec,ncol) = Vm(idet,ivec,ncol)/(Ener_np1(ivec) - Hdiag(idet))
+ end do
+ end do
+ if (debugdav) then
+ write(fdav,*) " vecteurs (HV-EV)/(E-Hii) de l'iteration :", iter+iter0
+ call wrtmat(Vm(1,1,ncol), ndet, min(ndet,10), nvec, fdav)
+ write(fdav,*)
+ end if
+
+ if (ndet.eq.1) goto 900
+ ! Orthonormalisation des nouveaux vecteurs corrections
+ ! schmidt avec les vecteurs converges
+ ! OK car ncol Vm(ndet,*,ncol) psi_SASS(ndet,*)
+ call orthog_Schmidt(Vm(1,1,ncol),psi_SASS(1,1),ndet,nvec,nconv,tol_orth)
+ ! schmidt avec anciens non convergés
+ ! OK car ncol Vm(ndet,*,ncol) et icol Vm(ndet,*,icol)
+ do icol = 1,ncol-1
+ call orthog_Schmidt(Vm(1,1,ncol),Vm(1,1,icol),ndet,nvec,nvec,tol_orth)
+ end do
+ if (debugdav) then
+ write(fdav,*) " vecteurs (HV-EV)/(E-Hii) de l'iteration apres othonorm:", iter+iter0
+ call wrtmat(Vm(1,1,ncol), ndet, min(10,ndet), nvec, fdav)
+ write(fdav,*)
+ flush(fdav)
+ end if
+
+ ! convergence sur vecteurs corrections puis
+ ! normalisation, reorthogonalisation renormalisation
+ clef=.false.
+ iconv = 0
+ vconv(:) = 0
+ do ivec = 1,nvec
+ tmp = dot_product(Vm(1:ndet,ivec,ncol),Vm(1:ndet,ivec,ncol))
+ if ((tmp.lt.tol_conv) .and. (iter>2) ) then ! vecteur converge
+ clef=.true.
+ iconv = iconv + 1
+ vconv(iconv) = ivec
+ else ! on normalise et continue
+ !if (tmp .gt. num_epsilon) then !to avoid dividing by 0 when there is only one vector
+ tmp = 1.d0/sqrt(tmp) ! on normalise
+ Vm(1:ndet,ivec,ncol) = Vm(1:ndet,ivec,ncol)*tmp
+ !endif
+ end if
+ end do
+ ! reorthogonalisation et renormalisation
+ call orthog_Schmidt(Vm(1,1,ncol),psi_SASS(1,1),ndet,nvec,nconv,tol_orth)
+ do icol = 1,ncol-1
+ call orthog_Schmidt(Vm(1,1,ncol),Vm(1,1,icol),ndet,nvec,nvec,tol_orth)
+ end do
+ if (clef) goto 202 ! si au moins 1 vecteur converge
+
+ if (debugdav) then
+ call orthonorm(Vm(1,1,ncol),ndet,nvec,tol_orth,tol_norm,.true.,prog_info, fdav)
+ else
+ call orthonorm(Vm(1,1,ncol),ndet,nvec,tol_orth,tol_norm,.false.,prog_info)
+ endif
+
+
+ cycle ! si pas de vecteur convergé on continue
+
+ ! Si un vecteur est converge on l'enlève et on contracte
+ ! attention à l'ordre des vecteurs
+202 continue
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*)' The vectors ',vconv(1:iconv),' seem converged : we take them out'
+ if (nconv.ne.0) write(f_output,9001) iter+iter0, ncol, nconv+iconv, nvec-iconv
+ end if
+ ! Si tous les vecteurs ont convergés
+ if (nconv+iconv.eq.nvectot) then
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) " "
+ write(f_output,'(A,ES8.1,A)') " >>> Davidson procedure converged on vectors corrections at", &
+ tol_conv, " <<<"
+ !write(f_output,*) " "
+ endif
+ nconv = nconv+iconv
+ goto 900 !convergence
+ end if
+ ! s'il reste des vecteurs à trouver
+ do ivec = 1,iconv
+ Vm(1:ndet,ivec,1) = psi_SASS(1:ndet,vconv(ivec)+nconv)
+ Ener_np1(ivec) = Ener(vconv(ivec)+nconv)
+ etmp(ivec) = deltaE(vconv(ivec)+nconv)
+ end do
+ do ivec = iconv, 1, -1
+ ! je fait une place en nconv+1
+ do jvec=vconv(ivec)-1, 1, -1
+ psi_SASS(1:ndet,1+jvec+nconv) = psi_SASS(1:ndet,jvec+nconv)
+ Ener(1+jvec+nconv) = Ener(jvec+nconv)
+ deltaE(1+jvec+nconv) = etmp(jvec+nconv)
+ end do
+ ! je mets le nouveau vecteur converge en nconv+1
+ psi_SASS(1:ndet,nconv+1) = Vm(1:ndet,ivec,1)
+ Ener(nconv+1) = Ener_np1(ivec)
+ deltaE(nconv+1) = etmp(ivec)
+ nconv = nconv + 1
+ nvec = nvec - 1
+ end do
+ ncol = 1
+ Vm(:,:,:) = 0.d0
+ Ener_np1(:) = 0.d0
+ do jvec = 1,nvec
+ Vm(1:ndet,jvec,ncol) = psi_SASS(1:ndet,nconv+jvec)
+ Ener_np1(jvec) = Ener(nconv+jvec)
+ end do
+
+ end do daviter
+!!$ Fin iterations de Davidson -----------------------------------
+
+
+!!$ Sortie sans convergence
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) " "
+ write(f_output,*) ">>> No convergence after ", iter+iter0-1, " iterations <<<"
+ write(f_output,*) " "
+ flush(f_output)
+ endif
+ goto 901
+
+!!$ Sortie convergé
+900 continue ! convergé
+ if (prog_info%id_cpu.eq.0) then
+ !write(f_output,*) " "
+ write(f_output,*) ">>> Convergence reached after ", iter+iter0-1, " iterations <<<"
+ write(f_output,*) " "
+ flush(f_output)
+ endif
+ goto 901
+
+!!$ On met tout en ordre
+901 continue
+ ! Réordonne les vecteurs pp
+ do ivec = 1,nvectot
+ vconv(ivec) = ivec
+ end do
+ do ivec = 1,nvectot
+ do jvec = ivec+1,nvectot
+ if (Ener(vconv(jvec)).lt.Ener(vconv(ivec))) then
+ kvec = vconv(ivec)
+ vconv(ivec) = vconv(jvec)
+ vconv(jvec) = kvec
+ end if
+ end do
+ end do
+ Ener_np1(1:nvectot) = Ener(1:nvectot)
+ Vm(1:ndet,1:nvectot,1) = psi_SASS(1:ndet,1:nvectot)
+ etmp(1:nvectot) = deltaE(1:nvectot)
+ do ivec = 1,nvectot
+ Ener(ivec) = Ener_np1(vconv(ivec))
+ psi_SASS(1:ndet,ivec) = Vm(1:ndet,vconv(ivec),1)
+ deltaE(ivec) = etmp(vconv(ivec))
+ end do
+
+ ! ecriture sur restart
+ rewind(f_restart)
+ write(f_restart) nvectot,ndet,nconv, iter+iter0
+ write(f_restart) Ecoeur,PotNuc
+ write(f_restart) (ener(ivec), ivec =1,nvectot)
+ do ivec = 1,nvectot
+ write(f_restart) (psi_SASS(idet,ivec),idet=1,ndet)
+ end do
+ flush(f_restart)
+
+
+!!$ Calcul du vecteur erreur || Hu -Eu||
+ Wm(:,:,:) = 0.d0
+ Ener_np1(:) = 0.d0
+ !if (.not.debugmat) then
+#ifdef VAR_MPI
+ if ((prog_info%id_cpu.eq.0).and.(prog_info%iprint.gt.0)) then
+ write(*,*) ''
+ write(*,*) '>>>> Compute error'
+ write(*,*) ''
+ endif
+#endif
+
+ call compute_HVm(psi_SASS, Wm(1,1,1), fock, hdiag, rspin, det, o_info, &
+ int_info, prog_info, nelact, ndet, nvectot, &
+ hcase_info, pcase_info, Hmat, intkindlist, mpilist, iter)
+ !else
+ ! write (6,*) ' >>> debugmat <<<'
+ ! call compute_HVm_mat(psi_SASS, Wm(1,1,1), det, ndet, nvectot, Hmat)
+ !end if
+ do ivec = 1,nvectot
+ etmp(ivec) = dot_product(psi_SASS(1:ndet,ivec),Wm(1:ndet,ivec,1))
+ end do
+ do ivec = 1,nvectot
+ Wm(:,ivec,2) = Wm(:,ivec,1) - Ener(ivec)*psi_SASS(:,ivec)
+ end do
+ do ivec = 1,nvectot
+ Ener_np1(ivec) = dot_product(Wm(:,ivec,2),Wm(:,ivec,2))
+ Ener_np1(ivec) = sqrt(Ener_np1(ivec))
+ end do
+
+!!$ Calcul orthogonormalite des vecteurs finaux
+ allocate (S(nvectot,nvectot))
+ S(:,:) = 0.d0
+ do jvec = 1,nvectot
+ S(jvec,jvec) = dot_product(psi_SASS(1:ndet,jvec),psi_SASS(1:ndet,jvec)) -1.d0
+ do ivec = 1,jvec-1
+ S(ivec,jvec) = dot_product(psi_SASS(1:ndet,ivec),psi_SASS(1:ndet,jvec))
+ S(jvec,ivec) = S(ivec,jvec)
+ end do
+ end do
+ write (f_output,*) " Overlap matrix between final vectors (difference to Id) "
+ call wrtmatE(S, nvectot, nvectot, nvectot, f_output)
+ write (f_output,*)
+ deallocate(S)
+
+!!$ ecriture sur sortie
+ nbre_col = 5
+ icol = nvectot/nbre_col
+ jvec = nvectot - icol*nbre_col
+ if (prog_info%id_cpu.eq.0) then
+ if (icol.eq.0) then
+ write(f_output,9004) (Ener(ivec)+Ecoeur+Potnuc, ivec=1,jvec)
+ write(f_output,9007) (Ener(ivec), ivec=1,jvec)
+ write(f_output,9009) ((Ener(ivec)-Ener(1)), ivec=1,jvec)
+ write(f_output,9008) ((Ener(ivec)-Ener(1))*mev, ivec=1,jvec)
+ write(f_output,9005) (Ener_np1(ivec), ivec=1,jvec)
+ write(f_output,9010) (deltaE(ivec), ivec=1,jvec)
+ ! write(f_output,9006) (Etmp(ivec)-Ener(ivec), ivec=1,jvec)
+ write(f_output,*)
+ else
+ do jcol = 1,icol
+ ish = (jcol-1)*nbre_col
+ write(f_output,9004) (Ener(ivec)+Ecoeur+Potnuc, ivec=1+ish,nbre_col+ish)
+ write(f_output,9007) (Ener(ivec), ivec=1+ish,nbre_col+ish)
+ write(f_output,9009) ((Ener(ivec)-Ener(1)), ivec=1+ish,nbre_col+ish)
+ write(f_output,9008) ((Ener(ivec)-Ener(1))*mev, ivec=1+ish,nbre_col+ish)
+ write(f_output,9005) (Ener_np1(ivec), ivec=1+ish,nbre_col+ish)
+ write(f_output,9010) (deltaE(ivec), ivec=1+ish,nbre_col+ish)
+ ! write(f_output,9006) (Etmp(ivec)-Ener(ivec), ivec=1+ish,nbre_col+ish)
+ write(f_output,*)
+ end do
+ if (jvec.ne.0) then
+ ish = icol*nbre_col
+ write(f_output,9004) (Ener(ivec)+Ecoeur+Potnuc, ivec=1+ish,jvec+ish)
+ write(f_output,9007) (Ener(ivec), ivec=1+ish,jvec+ish)
+ write(f_output,9009) ((Ener(ivec)-Ener(1)), ivec=1+ish,jvec+ish)
+ write(f_output,9008) ((Ener(ivec)-Ener(1))*mev, ivec=1+ish,jvec+ish)
+ write(f_output,9005) (Ener_np1(ivec), ivec=1+ish,jvec+ish)
+ write(f_output,9010) (deltaE(ivec), ivec=1+ish,jvec+ish)
+ ! write(f_output,9006) (Etmp(ivec)-Ener(ivec), ivec=1+ish,jvec+ish)
+ write(f_output,*)
+ end if
+ end if
+ endif
+ write(f_output,'(" Maximum precision expected on |Hv-Ev| : ", D8.1)') sqrt(max(tol_orth,tol_norm))
+ write(f_output,'(" Maximum precision expected on <v|H|v>-E : ", D8.1)') max(tol_orth,tol_norm)
+
+ write(f_output,*)
+
+
+
+
+#ifdef VAR_NOGEN
+ if (debug) then
+
+ allocate(Vmat(ndet,ndet), Emat(ndet))
+ Vmat(:,:) = 0.d0
+ Emat(:) = 0.d0
+ info = 0
+ !write(f_output,*) " verif 3"
+ call diag(Hmat,Emat,Vmat,ndet,3,f_output,info)
+ !do i=1,2
+ ! write(f_output,*) Vmat(:,i)
+ !end do
+
+ ! Calcul du vecteur erreur || Hu -Eu||
+ Wm(:,:,1) = 0.d0
+ Ener_np1(:) = 0.d0
+ do ivec =1, nvectot
+ do j = 1,ndet
+ do i = 1,ndet
+ Wm(i,ivec,1) = Wm(i,ivec,1) + Hmat(i,j)*Vmat(j,ivec)
+ end do
+ end do
+ end do
+ do ivec = 1,nvectot
+ etmp(ivec) = dot_product(Vmat(1:ndet,ivec),Wm(1:ndet,ivec,1))
+ end do
+ do ivec = 1,nvectot
+ Wm(:,ivec,1) = Wm(:,ivec,1) - Emat(ivec)*Vmat(:,ivec)
+ end do
+ do ivec = 1,nvectot
+ Ener_np1(ivec) = dot_product(Wm(:,ivec,1),Wm(:,ivec,1))
+ Ener_np1(ivec) = sqrt(Ener_np1(ivec))
+ end do
+ write(f_output,*) " Hv a la main"
+ do i= 1,nvectot
+ write(f_output,*) 'Vp Hmat, |Hv-Ev|, <v|H|v>-E' , i, Emat(i), Ener_np1(i), etmp(i)- Emat(i)
+ end do
+ write(f_output,*)
+
+ ! Calcul du vecteur erreur || Hu -Eu||
+ Wm(:,:,1) = 0.d0
+ Ener_np1(:) = 0.d0
+ call compute_HVm(Vmat, Wm, fock, hdiag, rspin, det, o_info, &
+ int_info, prog_info, nelact, ndet, nvectot, hcase_info, pcase_info, &
+ Hmat, intkindlist, mpilist, iter)
+ do ivec = 1,nvectot
+ etmp(ivec) = dot_product(Vmat(1:ndet,ivec),Wm(1:ndet,ivec,1))
+ end do
+ do ivec = 1,nvectot
+ Wm(:,ivec,1) = Wm(:,ivec,1) - Emat(ivec)*Vmat(:,ivec)
+ end do
+ do ivec = 1,nvectot
+ Ener_np1(ivec) = dot_product(Wm(:,ivec,1),Wm(:,ivec,1))
+ Ener_np1(ivec) = sqrt(Ener_np1(ivec))
+ end do
+ write(f_output,*) " Hv avec compute_HVm"
+ do i= 1,nvectot
+ write(f_output,*) 'Vp Hmat, |Hv-Ev|, <v|H|v>-E' , i, Emat(i), Ener_np1(i), etmp(i)- Emat(i)
+ end do
+ deallocate(Vmat,Emat)
+
+ endif
+#endif
+
+
+!!$ On nettoie et ferme
+902 deallocate(Vm,Wm)
+ deallocate(H_dav,vect)
+ deallocate(Ener_np1,Etmp,vconv)
+ call intkind_H_all_free(intkindlist)
+
+ deallocate(mpilist%l)
+ deallocate(mpilist%indx)
+ deallocate(mpilist%cputime)
+ deallocate(mpilist%wtime)
+
+ deallocate(Hmat)
+ close(f_restart)
+ close(f_mat)
+ close(f_mat2)
+ close(f_bmat)
+ close(666)
+ close(667)
+
+ !Save energies
+ !allocate(ener_info%ener(nvectot))
+ ener_info%ener(:) = ener(:)
+ deallocate(ener)
+
+!!$ Formats
+9001 format("-- Davidson' iteration:",i5," ncol=",i3, " Nbre of converged vectors:",i3,&
+ " Nbre of remaining vectors:",i3)
+9004 format(1x,"Energies : ",5(f22.15,2x))
+9005 format(1x,"|Hv-Ev| : ",5(ES22.4E2,2x))
+9006 format(1x,"<vHv>-E : ",5(ES22.4E2,2x))
+9007 format(1x,"E ss ref : ",5(f22.15,2x))
+9008 format(1x,"dE (meV) : ",5(f22.15,2x))
+9009 format(1x,"dE (a.u.): ",5(f22.15,2x))
+9010 format(1x,"deltaE : ",5(ES22.4E2,2x))
+
+ end subroutine diag_sass
+
+ !$========================================================================
+ !> @brief One Davidson iteration step
+ !> @author MB Lepetit & E Rebolini
+ !> @date June 2018
+ !
+ !> @param[inout] H_dav Hamiltonien effectif sur les vecteurs Vm
+ !! H_dav(i,j) = Vm(i)*H*Vm(j)
+ !> @param[inout] ener Array to store the iteration energies
+ !> @param[inout] ener_np1 Array to store the N+1 iteration energies
+ !> @param[inout] deltaE Array to store the energy difference E(n)-E(n-1)
+ !> @param[inout] vect Eigenvectors oh Hdav
+ !> @param[inout] psiSASS Target states
+ !> @param[in] Vm
+ !> @param[inout] Wm
+ !> @param[in] DimHeff Size of the effective Hamiltanian H_dav
+ !! nvectot*(Sizeheff +1)
+ !> @param[inout] ncol
+ !> @param[in] fock Fock matrix in the AO basis
+ !> @param[in] hdiag Diagonal elms of the Hamiltonian matrix
+ !> @param[in] rspin List of the spin-ordered active parts of the determinants
+ !> @param[in] det List of blocks of determinants D_m^n
+ !> @param[in] o_info Orbital information
+ !> @param[in] int_info Integral information
+ !> @param[in] v_info Info on the target states
+ !> @param[in] prog_info
+ !> @param[in] nelact Nb of active electrons
+ !> @param[in] ndet Total number of determinants
+ !> @param[in] nvec Nb of vectors in the currect iteration
+ !! <= nvectot the nb of target vectors
+ !> @param[in] nconv nb of converged vectors
+ !> @param[in] hcase_info
+ !> @param[in] pcase_info
+ !> @param[in] bdav_info
+ !> @param[in] ener_info
+ !> @param[in] Hmat
+ !> @param[in] intkindlist
+ !> @param[in] mpilist
+ !> @param[in] iter
+ !$========================================================================
+ subroutine david_iter(H_dav, ener, ener_np1, deltaE, vect, psi_SASS, &
+ Vm, Wm, Dimheff, ncol, fock, hdiag, rspin, &
+ det, o_info, int_info, v_info, prog_info, nelact, ndet, nvec, nconv, &
+ hcase_info, pcase_info, bdav_info, ener_info, Hmat, intkindlist, mpilist, iter)
+
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: H_dav
+ real(kd_dble), dimension(:), allocatable, intent(inout) :: ener, ener_np1, deltaE
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: vect
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: psi_SASS
+ real(kd_dble), dimension(:,:,:), allocatable, intent(in) :: Vm
+ real(kd_dble), dimension(:,:,:), allocatable, intent(inout) :: Wm
+ integer, intent(in) :: Dimheff, nconv
+ integer, intent(inout) :: ncol
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ real(kd_dble), dimension(:), allocatable, intent(in) :: hdiag
+ type(spinrlist), intent(in) :: rspin
+ type(deter_dblocklist), intent(in) :: det
+ type(prog_infotype), intent(in) :: prog_info
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(v_infotype), intent(in) :: v_info
+ type(david_infotype), intent(in) :: bdav_info
+ type(ener_infotype), intent(in) :: ener_info
+ integer, intent(in) :: nelact
+ integer, intent(in) :: ndet, nvec
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable :: Hmat
+ type(intkind_H), dimension(:), allocatable :: intkindlist
+ type(int_blockpair_list), intent(inout) :: mpilist
+ integer, intent(in) :: iter
+
+ real(kd_dble) :: t1, ostart, t2, oend, totalcputime
+ real(kd_dble) :: hij
+ real(kd_dble) :: Ecoeur, potnuc
+ integer :: nsh, ivec, jvec, icol, jcol
+ integer :: iout, ish, jsh, iter0, nvectot
+ integer :: fdav = 667 !file id for debugdav printing
+ integer :: i,j
+ !integer :: kcol, ksh, kvec
+ logical :: debugdav
+#ifdef VAR_MPI
+ integer :: info
+#endif
+
+ real(kd_dble), dimension(:), allocatable :: Enertmp, etmp
+ real(kd_dble), dimension(:,:), allocatable :: davtmp, vecttmp
+
+ debugdav = bdav_info%debug_dav
+
+ iter0 = bdav_info%iter0
+ potnuc = ener_info%potnuc
+ Ecoeur = ener_info%Ecoeur
+ nvectot = v_info%nvec
+
+
+
+#ifdef VAR_MPI
+ if ((prog_info%id_cpu.eq.0).and.(prog_info%iprint.gt.0)) then
+ write(*,*) ''
+ write(*,*) '>>>> Iteration', iter
+ write(*,*) ''
+ endif
+ call MPI_Barrier( MPI_COMM_WORLD, info)
+ if (((prog_info%restart) .and. (iter .eq. 2)) .or. &
+ ((.not.prog_info%restart) .and. (iter .eq. 3))) then
+
+ if (prog_info%nb_cpu .ne. 1) then
+ if (prog_info%mpi_load_balance) then
+ call sort_mpi_timings(mpilist, det, prog_info, iter)
+ endif
+ endif
+ endif
+#endif
+
+ call gettime(t1,ostart)
+
+ Wm(:,:,ncol)=0.d0
+
+ ! Calcul de W = H * V cad |W_m^J> = H_JI |V_m^I>
+ call compute_HVm(Vm(1,1,ncol), Wm(1,1,ncol), fock, hdiag, rspin, &
+ det, o_info, int_info, prog_info, nelact, ndet, nvec, &
+ hcase_info, pcase_info, Hmat, intkindlist, mpilist, iter)
+
+#ifdef VAR_NOGEN
+ if (prog_info%iprintHmat .gt. 0) then
+
+ write(f_bmat) Hmat
+ flush(f_bmat)
+ write(f_output, *) '>>> Hmat written to binary file prefix.bmat'
+
+ if (prog_info%iprintHmat .gt.1) then
+ write(f_mat,*) ndet
+ do i = 1, ndet
+ write(f_mat,*) Hmat(i,:)
+ enddo
+ write(f_mat,*) ''
+ write(f_mat,*) ndet
+ flush(f_mat)
+ write(f_output, *) '>>> Hmat written to text file prefix.mat'
+
+ if (prog_info%iprintHmat .gt.2) then
+ do i = 1, ndet
+ do j=1, ndet
+ write(f_mat2,*) i,j,Hmat(i,j)
+ enddo
+ enddo
+ flush(f_mat2)
+ write(f_output, *) '>>> Hmat written to text file prefix.mat with explicit indices'
+ endif
+ endif
+ call check_hermiticity(Hmat,ndet)
+ endif
+#endif
+
+ ! Calcul de l'Hamiltonien effectif H_dav
+ ! bloc iteration iter -> <Vm(ivec,ncol)|H|Vm(jvec,ncol)>
+ nsh = (ncol-1)*nvec
+ do ivec = 1,nvec
+ do jvec = 1,ivec
+ hij= 0.d0
+ hij = dot_product(Vm(1:ndet,ivec,ncol),Wm(1:ndet,jvec,ncol))
+ H_dav(ivec+nsh,jvec+nsh) = hij
+ H_dav(jvec+nsh,ivec+nsh) = hij
+ end do
+ end do
+
+ ! bloc iteration iter -> <Vm(ivec,jcol)|H|Vm(jvec,ncol)> avec jcol < ncol
+ do jcol = 1, ncol-1
+ jsh = (jcol-1)*nvec
+ do jvec = 1,nvec
+ do ivec = 1,nvec
+ hij= 0.d0
+ hij = dot_product(Vm(1:ndet,jvec,jcol),Wm(1:ndet,ivec,ncol))
+ H_dav(ivec+nsh,jvec+jsh) = hij
+ H_dav(jvec+jsh,ivec+nsh) = hij
+ end do
+ end do
+ end do
+
+ if (debugdav) then
+ write(fdav,*) "H_dav de l'iteration :", iter+iter0, ncol, nvec
+ call wrtmat(H_dav,Dimheff,nvec*ncol, nvec*ncol, fdav)
+ write(fdav,*)
+ endif
+
+ ! si iter=1 ecrire l'énergie des vecteurs d'essais
+ if (iter.eq.1) then
+ do ivec = 1, nvec
+ ener(ivec) = H_dav(ivec,ivec)
+ end do
+ if (prog_info%id_cpu.eq.0) then
+ call gettime(t2,oend)
+#ifdef VAR_MPI
+ call wrt_ener_mpi(Ener,Ecoeur+Potnuc,nvec,0,f_output, 0.d0, 0.d0, 0.d0)
+#else
+ call wrt_ener(Ener,Ecoeur+Potnuc,nvec,0,f_output, 0.d0, 0.d0)
+#endif
+ flush(f_output)
+ endif
+ end if
+
+ ! Diagonalisation de H_dav
+ Ener_np1(:) = 0.d0 !Energies N+1
+ Vect(:,:) = 0.d0 !Eigenvectors of Davidson Heff
+ iout = 0
+
+ allocate(davtmp(nvec*ncol,nvec*ncol))
+ allocate(vecttmp(nvec*ncol,nvec*ncol))
+ allocate(enertmp(nvec*ncol))
+
+ davtmp(:,:) = 0.d0
+ vecttmp(:,:) = 0.d0
+ enertmp(:) = 0.d0
+
+ do ivec = 1, nvec*ncol
+ do jvec = 1, nvec*ncol
+ davtmp(ivec, jvec) = H_dav(ivec, jvec)
+ enddo
+ enddo
+
+ call diag(davtmp,Enertmp,Vecttmp,ncol*nvec,prog_info%idiag,fdav,iout)
+
+ !vecttmp : rotation matrix in between the Vm vectors
+ !should be unitary
+ Vect(1:nvec*ncol,1:nvec*ncol) = Vecttmp(1:nvec*ncol,1:nvec*ncol)
+ Ener_np1(1:nvec*ncol) = enertmp(1:nvec*ncol)
+ deltaE(1+nconv:nvectot) = Ener_np1(1:nvec)-Ener(1+nconv:nvectot)
+
+
+ deallocate(davtmp)
+ deallocate(Vecttmp)
+ deallocate(enertmp)
+
+ if (debugdav) then
+ if (prog_info%id_cpu .eq. 0) &
+ write(fdav,*) ">>> vecteurs vect de l'iteration :", iter + iter0
+ call wrtmat(Vect,Dimheff,nvec*ncol,nvec*ncol, fdav)
+ end if
+
+
+ ! On ecrit les energies
+ call gettime(t2,oend)
+
+ if (prog_info%id_cpu.eq.0) then
+#ifdef VAR_MPI
+ totalcputime = sum(mpilist%cputime(:))
+ !if (debugdav) then
+ call wrt_ener_mpi(Ener_np1,Ecoeur+Potnuc,nvec,iter+iter0,f_output, totalcputime, &
+ t2-t1, oend-ostart, deltaE(nconv+1:nvectot))
+ !else
+ ! call wrt_ener_mpi(Ener_np1,Ecoeur+Potnuc,nvec,iter+iter0,f_output, totalcputime, t2-t1, oend-ostart)
+ !endif
+#else
+ totalcputime = t2-t1
+ !if (debugdav) then
+ call wrt_ener(Ener_np1,Ecoeur+Potnuc,nvec,iter+iter0,f_output, totalcputime, &
+ oend-ostart, deltaE(nconv+1:nvectot))
+ !else
+ ! call wrt_ener(Ener_np1,Ecoeur+Potnuc,nvec,iter+iter0,f_output, totalcputime, oend-ostart)
+ !endif
+
+#endif
+ flush(f_output)
+ endif
+ if (debugdav) call wrt_ener(Ener_np1,0.d0,nvec,iter+iter0,fdav)
+
+ ! On met à jour psi_SASS
+ do jvec = 1,nvec
+ psi_SASS(1:ndet,jvec+nconv) = 0.d0
+ do icol = 1,ncol
+ ish = (icol-1)*nvec
+ do ivec = 1,nvec
+ psi_SASS(1:ndet,jvec+nconv) = psi_SASS(1:ndet,jvec+nconv) &
+ + Vect(ivec+ish,jvec)*Vm(1:ndet,ivec,icol)
+ end do
+ end do
+ end do
+
+ if (debugdav) then
+ write(fdav,*) " vecteurs psi_SASS de l'iteration :", iter+iter0, &
+ " nvec = ", nconv+1,nconv+nvec," ncol =", ncol
+ call wrtmat(psi_SASS,ndet,min(ndet,10),nvectot, fdav)
+ write(fdav,*)
+ allocate(vecttmp(ndet,nvectot))
+ allocate(etmp(nvectot))
+ etmp(:) = 0.d0
+ vecttmp(:,:) = 0.d0
+ call compute_HVm(psi_SASS(1,1), vecttmp(1,1), fock, hdiag, rspin, &
+ det, o_info, int_info, prog_info, nelact, ndet, nvec, &
+ hcase_info, pcase_info, Hmat, intkindlist, mpilist, iter)
+ do ivec = 1,nvectot
+ etmp(ivec) = dot_product(psi_SASS(1:ndet,ivec),vecttmp(1:ndet,ivec))
+ end do
+ write(fdav,*)
+ write(fdav,*) " Energies PSI_SASS a it ", iter+iter0
+ call wrt_ener(Etmp,Ecoeur+Potnuc,nvectot,iter+iter0,fdav)
+ call wrt_ener(Ener_np1,Ecoeur+Potnuc,nvectot,iter+iter0,fdav)
+ write(fdav,*)"===="
+ deallocate(vecttmp)
+ deallocate(etmp)
+ end if
+
+ end subroutine david_iter
+
+ !$========================================================================
+ !> @brief wrt_ener
+ !> @author MBL
+ !> @date July 2018
+ !
+ !> @param[in] Ener(1:nvec) energies to be printed
+ !> @param[in] iter Davidson iteration
+ !> @param[in] File on which the energies will be printedDavidson iteration
+ !$========================================================================
+ subroutine wrt_ener(Ener,Esh,nvec,iter,file,time, walltime, deltaE)
+ Integer, intent(in) :: nvec,iter,file
+ real(kd_dble), dimension(nvec), intent(in) :: Ener
+ real(kd_dble), dimension(nvec), optional, intent(in) :: deltaE
+ real(kd_dble), intent(in) :: Esh
+ real(kd_dble), optional :: time, walltime
+
+ Integer :: nbre_col, icol, jcol, ish, ivec, jvec
+
+ nbre_col = 5
+ icol = nvec/ nbre_col
+ jvec = nvec - icol*nbre_col
+ if (present(time)) then
+ if (.not.(present(walltime))) walltime = time
+
+ !less than 5 energies, only one row
+ if (icol.eq.0) then
+ write(file,9003) iter, time, walltime, (ener(ivec)+Esh, ivec=1,jvec)
+ if (present(deltaE)) then
+ write(file,9005) (deltaE(ivec), ivec=1,jvec)
+ endif
+ else
+ !first row has timings and iter number
+ write(file,9003) iter, time, walltime, (ener(ivec)+Esh, ivec=1,nbre_col)
+ if (present(deltaE)) then
+ write(file,9005) (deltaE(ivec), ivec=1,nbre_col)
+ endif
+ do jcol = 2,icol
+ ish = (jcol-1)*nbre_col
+ write(file,9004) (ener(ivec)+Esh, ivec=1+ish,nbre_col+ish)
+ if (present(deltaE)) then
+ write(file,9005) (deltaE(ivec), ivec=1+ish,nbre_col+ish)
+ endif
+ end do
+ !Last line has less than 5 energies
+ if (jvec.ne.0) then
+ ish = icol*nbre_col
+ write(file,9004) (ener(ivec)+Esh, ivec=1+ish,jvec+ish)
+ if (present(deltaE)) then
+ write(file,9005) (deltaE(ivec), ivec=1+ish,jvec+ish)
+ endif
+ end if
+ end if
+ else
+ !For guess energies
+ if (icol.eq.0) then
+ write(file,9002) iter, (ener(ivec)+Esh, ivec=1,jvec)
+ else
+ do jcol = 1,icol
+ ish = (jcol-1)*nbre_col
+ write(file,9002) iter, (ener(ivec)+Esh, ivec=1+ish,nbre_col+ish)
+ end do
+ if (jvec.ne.0) then
+ ish = icol*nbre_col
+ write(file,9002) iter, (ener(ivec)+Esh, ivec=1+ish,jvec+ish)
+ end if
+ end if
+ endif
+
+9002 format(1x,"#Iter:",i5," Energies : ", 5(f17.10,2x))
+ !9003 format(1x,"#Iter:",i5," tCPU:",f12.4, " second(s)"," Energies : ", 5(f17.10,2x))
+9003 format(1x,i6,X,f12.4,X,f12.4,X,5(f17.10,2x))
+9004 format(1x,6x,X,12X,X,12X,X,5(f17.10,2x))
+9005 format(30X,11X,5(ES10.3E2,9x))
+ end subroutine wrt_ener
+
+ !$========================================================================
+ !> @brief wrt_ener
+ !> @author MBL
+ !> @date July 2018
+ !
+ !> @param[in] Ener(1:nvec) energies to be printed
+ !> @param[in] iter Davidson iteration
+ !> @param[in] File on which the energies will be printedDavidson iteration
+ !$========================================================================
+ subroutine wrt_ener_mpi(Ener, Esh, nvec, iter, file, time, timecpu0, walltime, deltaE)
+ Integer, intent(in) :: nvec,iter,file
+ real(kd_dble), dimension(nvec), intent(in) :: Ener
+ real(kd_dble), dimension(nvec), optional, intent(in) :: deltaE
+ real(kd_dble), intent(in) :: Esh
+ real(kd_dble):: time, walltime, timecpu0
+
+ Integer :: nbre_col, icol, jcol, ish, ivec, jvec
+
+ nbre_col = 5
+ icol = nvec/ nbre_col
+ jvec = nvec - icol*nbre_col
+
+ if (icol.eq.0) then
+ !less than 5 energies, only one row
+ write(file,9011) iter, time, timecpu0, walltime, (ener(ivec)+Esh, ivec=1,jvec)
+ if (present(deltaE)) then
+ write(file,9005) (deltaE(ivec), ivec=1,jvec)
+ endif
+ else
+ !first row has timings and iter number
+ write(file,9011) iter, time, timecpu0, walltime, (ener(ivec)+Esh, ivec=1,nbre_col)
+ if (present(deltaE)) then
+ write(file,9005) (deltaE(ivec), ivec=1,jvec)
+ endif
+ do jcol = 2,icol
+ ish = (jcol-1)*nbre_col
+ write(file,9012) (ener(ivec)+Esh, ivec=1+ish,nbre_col+ish)
+ if (present(deltaE)) then
+ write(file,9005) (deltaE(ivec), ivec=1,jvec)
+ endif
+ end do
+ if (jvec.ne.0) then
+ ish = icol*nbre_col
+ write(file,9012) (ener(ivec)+Esh, ivec=1+ish,jvec+ish)
+ if (present(deltaE)) then
+ write(file,9005) (deltaE(ivec), ivec=1+ish,jvec+ish)
+ endif
+ end if
+
+ flush(file)
+
+ end if
+
+9011 format(1x,i6,3(X,f12.4),X,5(f17.10,2x))
+9012 format(7X,39X,X,5(f17.10,2x))
+9005 format(7X,46X,X,5(ES10.3E2,9x))
+
+ end subroutine wrt_ener_mpi
+
+ !$========================================================================
+ !> @brief Check hermiticity of the saved Hamiltonian matrix
+ !> @author ER
+ !> @date 2018
+ !$========================================================================
+ subroutine check_hermiticity(Hmat,ndet)
+
+ real(kd_dble), dimension(:,:) :: hmat
+ integer :: ndet
+
+ real(kd_dble) :: tol = 1.d-15
+ integer :: i,j
+ real(kd_dble) :: err, toterr
+ logical :: l_hermit
+
+ l_hermit = .true.
+ toterr = 0.d0
+ do i=1, ndet
+ do j=i,ndet
+ err = abs(Hmat(i,j) - Hmat(j,i))
+ if (err .ge. tol) then
+ write(6,*) i,j,Hmat(i,j), Hmat(j,i),err
+ flush(6)
+ l_hermit = .false.
+
+ endif
+ toterr = toterr + err
+ end do
+ end do
+
+ if (.not.(l_hermit)) then
+ write(f_output,*) 'Deviation from hermiticity', toterr, toterr/(ndet*ndet)
+ call SASS_quit('Heff Not symmetric',f_output)
+ endif
+
+ end subroutine check_hermiticity
+
+ !$========================================================================
+ !> @brief Sort Mpi timings
+ !> @author ER
+ !> @date Dec. 2019
+ !$========================================================================
+ subroutine sort_mpi_timings(mpilist, det, prog_info, iter)
+
+ type(int_blockpair_list), intent(inout) :: mpilist
+ type(deter_dblocklist), intent(in) :: det
+ type(prog_infotype), intent(in) :: prog_info
+ integer, intent(in) :: iter
+
+ type(int_blockpair) :: mpiitem
+ integer :: i, nint_blockpair
+ integer, dimension(:), allocatable :: tmp
+ integer :: nb_cpu, id_cpu, nbig_cpu
+
+ integer :: tmpbeg, tmpend, posindex
+ real(kd_dble),dimension(:),allocatable :: sum_wall
+
+ type(deter_dblock), pointer :: DblockI, DblockJ
+
+! integer :: iunit, iunit_sort
+
+ nint_blockpair = mpilist%nint_blockpair
+
+ allocate(tmp(nint_blockpair))
+ tmp(:) = 0
+
+
+ !Sort the wall timing in descending order, the array of permutation wrt the initial ordering
+ !is given in tmp
+ call hpsort_eps_epw(nint_blockpair, &
+ mpilist%wtime, tmp, 1.d-6)
+
+ tmpbeg = 1
+ tmpend = nint_blockpair
+ posindex = 1
+
+ nb_cpu = prog_info%nb_cpu
+ allocate(sum_wall(nb_cpu))
+
+ mpilist%indx(:) = 0
+ sum_wall(:) = 0.d0
+
+
+ !Assign the first nb_cpu indices to the biggest calculations
+ do id_cpu = 1, nb_cpu
+ mpilist%indx(posindex) = tmp(tmpbeg)
+ sum_wall(id_cpu) = mpilist%wtime(id_cpu)
+ posindex = posindex + 1
+ tmpbeg = tmpbeg + 1
+ enddo
+
+ !The biggest CPU is nb 1
+ nbig_cpu = 1
+
+ do while (posindex .le. nint_blockpair )! (nint_blockpair - mod(nint_blockpair,nb_cpu)))
+
+ if (nbig_cpu .lt. nb_cpu) then
+ if (maxval(sum_wall(1:nbig_cpu)) .gt. sum_wall(nbig_cpu+1)) then
+ !On ajoute des petits timings sur les premiers cpus
+ do id_cpu = 1, nbig_cpu
+ if (posindex .gt. nint_blockpair) goto 1000
+ mpilist%indx(posindex) = tmp(tmpend)
+ sum_wall(id_cpu) = sum_wall(id_cpu) + mpilist%wtime(tmpend)
+ tmpend = tmpend - 1
+ posindex = posindex + 1
+ enddo
+ !et des gros sur les suivants
+ do id_cpu = nbig_cpu + 1, nb_cpu
+ if (posindex .gt. nint_blockpair) goto 1000
+ mpilist%indx(posindex) = tmp(tmpbeg)
+ sum_wall(id_cpu) = sum_wall(id_cpu) + mpilist%wtime(tmpbeg)
+ posindex = posindex + 1
+ tmpbeg = tmpbeg + 1
+ enddo
+ else
+ !le cpu suivant est devenu aussi gros
+
+ nbig_cpu = nbig_cpu + 1
+ do id_cpu = 1, nbig_cpu
+ if (posindex .gt. nint_blockpair) goto 1000
+ mpilist%indx(posindex) = tmp(tmpend)
+ sum_wall(id_cpu) = sum_wall(id_cpu) + mpilist%wtime(tmpend)
+ tmpend = tmpend - 1
+ posindex = posindex + 1
+ enddo
+ do id_cpu = nbig_cpu + 1, nb_cpu
+ if (posindex .gt. nint_blockpair) goto 1000
+ mpilist%indx(posindex) = tmp(tmpbeg)
+ sum_wall(id_cpu) = sum_wall(id_cpu) + mpilist%wtime(tmpbeg)
+ posindex = posindex + 1
+ tmpbeg = tmpbeg + 1
+ enddo
+ endif
+ else
+ nbig_cpu = 1
+ do while ((maxval(sum_wall(1:nbig_cpu)) .lt. sum_wall(nbig_cpu+1)) .and. &
+ (posindex .lt. (nint_blockpair - mod(nint_blockpair,nb_cpu))))
+ do id_cpu = 1, nb_cpu
+ if (posindex .gt. nint_blockpair) goto 1000
+ mpilist%indx(posindex) = tmp(tmpbeg)
+ sum_wall(id_cpu) = sum_wall(id_cpu) + mpilist%wtime(tmpbeg)
+ posindex = posindex + 1
+ tmpbeg = tmpbeg + 1
+ enddo
+ enddo
+
+ endif
+ enddo
+
+1000 continue
+
+ if ((prog_info%id_cpu .eq. 0).and. (prog_info%iprint .ge. 0)) then
+ write(*,*) 'Final Sum Wall time on the dfifferent CPUs'
+ write(*,*) sum_wall(:)
+ endif
+
+!!$ call wrt_int_blockpair_list(mpilist, iunit_sort)
+!!$
+!!$ write(iunit,*) '>>> Ordered CPU time iter', iter
+!!$ do i=1,mpilist%nint_blockpair
+!!$ mpiitem = mpilist%l(mpilist%indx(i))
+!!$ DblockI => det%detblock(mpiitem%indxI)%p
+!!$ DblockJ => det%detblock(mpiitem%indxJ)%p
+!!$ write(iunit,'(3A,I3,A,I3)') &
+!!$ 'Integral ', mpiitem%intkind, ' on blocks D', &
+!!$ DblockI%name, ' and D', DblockJ%name
+!!$
+!!$ write(iunit,'(3A,I3,A,I3,A,I0,2A,2(F12.4,A),F12.4)') &
+!!$ 'Integral ', mpiitem%intkind, ' on blocks D', &
+!!$ DblockI%name, ' and D',&
+!!$ DblockJ%name, ' (spin ',&
+!!$ mpiitem%spincase,')', &
+!!$ ' added in tCPU:',mpilist%cputime(tmp(i)),' s, tWall:', &
+!!$ mpilist%wtime(i),' s, ratio:',mpilist%cputime(tmp(i))/mpilist%wtime(i)
+!!$
+!!$ enddo
+!!$ endif
+ deallocate(tmp)
+ deallocate(sum_wall)
+!!$ close(iunit)
+!!$ close(iunit_sort)
+
+ end subroutine sort_mpi_timings
+
+ !> @brief Read Hmat from file and diagonalise
+ !> @author Elisa Rebolini
+ !> @date 03-2020
+ !
+ !> @param[inout] Hmat
+ !> @param[in] ndet Nb of determinants
+ !> @param[in] nvec Nb of requested eigenvalues/eigenvectors
+ !> @param[in] prog_info
+ subroutine read_hmat_from_file(Hmat, ndet, nvec, prog_info)
+
+ integer, intent(in) :: ndet, nvec
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: Hmat
+ type(prog_infotype), intent(in) :: prog_info
+
+ real(kd_dble), dimension(:,:), allocatable :: Vmat
+ real(kd_dble), dimension(:), allocatable :: Emat
+ integer :: ntmp, info, i
+
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) 'Read Hmat from file'
+ endif
+
+ if (.not.(allocated(Hmat))) allocate(Hmat(ndet,ndet))
+
+ Hmat(:,:) = 0.d0
+ rewind(f_mat)
+ read(f_mat,*) ntmp
+ do i = 1, ndet
+ read(f_mat,*) Hmat(i,:)
+ end do
+
+ end subroutine read_hmat_from_file
+
+end module SASS_diag
+
+!!$ Local Variables:
+!!$ coding: utf-8-unix
+!!$ End:
diff --git a/src/all_case.F90 b/src/all_case.F90
new file mode 100644
index 0000000000000000000000000000000000000000..71fde7760196e2726ff7e4f2bacb73494ed324fb
--- /dev/null
+++ b/src/all_case.F90
@@ -0,0 +1,14012 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+module utils_intcase
+
+ use info
+ use files
+
+ implicit none
+
+ !$============================================================
+ !> @brief type for a 2-el integral case for H V_m
+ !!
+ !! elm = sign * sum_Nsumact d12 d34 (x1 x2 | x3 x4)
+ !! - d14 d23 (x1 x4 | x2 x3)
+ !$============================================================
+ type, public :: intcase
+ !> @brief character string for the integral kind and the
+ !! exchange integral case when necessaey
+ character(4) :: intkind, intkindx
+ !> @brief Id number for the determinant blocks I and J
+ integer :: id_blockI, id_blockJ
+ !> @brief Id number for the hole, particle and active cases
+ integer :: hcase, pcase, actcase
+ !> @brief Logical for the exchange integral block
+ logical :: lintx
+ !> @brief Range of the summation over the active orbitals
+ !! 0 when no summation
+ integer :: nsumact
+ !> @brief Global sign of the term
+ integer :: sign
+ !> @brief Presence of the delta functions
+ logical :: d12, d34, d14, d23
+ !> @brief character strings for the spatial orbitals
+ character(8) :: x1, x2, x3, x4
+ !> @brief order of the exchanged orbitals
+ integer :: OrderExc
+ end type intcase
+
+ type, public :: intcasep
+ type(intcase), pointer :: p
+ end type intcasep
+
+ type, public :: intcase_list
+ integer :: ncases = 686! 70
+ type(intcasep), dimension(:), allocatable :: cases
+ end type intcase_list
+
+contains
+
+
+ !!============================================================
+ !> @brief Write an intcase object to f_output
+ !! parameters
+ !> @author Elisa Rebolini
+ !> @date Nov 2018
+ !!
+ !> @param case Integral case
+ !> @param id ID number of the integral case
+ !!============================================================
+ subroutine wrt_intcase_id(case,id)
+
+ type(intcase), intent(in) :: case
+ integer, intent(in) :: id
+
+ integer :: fid
+
+ fid = f_output
+
+ write(fid,'(X,A,X,I0)') 'Intcase',id
+ write(fid,'(3X,A,X,A)') 'intkind',case%intkind
+ end subroutine wrt_intcase_id
+
+ !!============================================================
+ !> @brief Initialise an intcase object from a given list of
+ !! parameters
+ !> @author Elisa Rebolini
+ !> @date Nov 2018
+ !!
+ !> @param a intcase object to be initialised
+ !> @param intkind character string for the integral kind
+ !> @param intkind character string for the exchange integral kind
+ !> @param id_blockI Id number for the determinant block I
+ !> @param id_blockJ Id number for the determinant block J
+ !> @param hcase Id number for the hole case
+ !> @param pcase Id number for the particule case
+ !> @param actcase Id number for the active case
+ !> @param lintx
+ !> @param nsumact
+ !> @param sign
+ !> @param d12
+ !> @param d34
+ !> @param d14
+ !> @param d23
+ !> @param x1
+ !> @param x2
+ !> @param x3
+ !> @param x4
+ !> @param orderexc
+ !!============================================================
+ subroutine intcase_init(a, intkind, intkindx, id_blockI, id_blockJ, &
+ hcase, pcase, actcase, lintx, nsumact, sign, d12, d34, d14, d23, &
+ x1, x2, x3, x4, orderexc)
+
+ type(intcase), intent(inout) :: a
+ character(4), intent(in) :: intkind, intkindx
+ integer, intent(in) :: id_blockI, id_blockJ
+ integer, intent(in) :: hcase, pcase, actcase
+ logical, intent(in) :: lintx
+ integer, intent(in) :: nsumact
+ integer, intent(in) :: sign
+ logical, intent(in) :: d12, d34, d14, d23
+ character(8), intent(in) :: x1, x2, x3, x4
+ integer, intent(in) :: orderexc
+
+ a%intkind = intkind
+ a%intkindx = intkindx
+ a%id_blockI = id_blockI
+ a%id_blockJ = id_blockJ
+ a%hcase = hcase
+ a%pcase = pcase
+ a%actcase = actcase
+ a%lintx = lintx
+ a%nsumact = nsumact
+ a%sign = sign
+ a%d12 = d12
+ a%d34 = d34
+ a%d14 = d14
+ a%d23 = d23
+ a%x1 = x1
+ a%x2 = x2
+ a%x3 = x3
+ a%x4 = x4
+ a%orderexc = orderexc
+
+ end subroutine intcase_init
+
+ !!============================================================
+ !> @brief Initialise and fill the list of all intcases
+ !> @author Elisa Rebolini
+ !> @date Nov 2018
+ !!
+ !> @param intcases Array of all intcases
+ !> @param nelact Nb of active electrons
+ !!============================================================
+ subroutine intcaselist_init(intcases, nelact)
+
+ integer, intent(in) :: nelact
+ type(intcase_list), intent(out) :: intcases
+
+ integer :: intcase_id
+ type(intcase), pointer :: a
+
+ character(4) :: intkind, intkindx
+ integer :: id_blockI, id_blockJ
+ integer :: hcase, pcase, actcase
+ logical :: lintx
+ integer :: nsumact
+ integer :: sign
+ logical :: d12, d34, d14, d23
+ character(8) :: x1, x2, x3, x4
+ integer :: orderexc
+
+ allocate(intcases%cases(intcases%ncases))
+
+ do intcase_id = 1, intcases%ncases
+ nullify(intcases%cases(intcase_id)%p)
+ allocate(intcases%cases(intcase_id)%p)
+ a => intcases%cases(intcase_id)%p
+ select case (intcase_id)
+ case (1)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 11
+ id_blockJ = 11
+ hcase = 9
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (2)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 11
+ id_blockJ = 11
+ hcase = 5
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .true.
+ d14 = .true.
+ d23 = .true.
+ orderexc = 1423
+ case (3)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 11
+ id_blockJ = 11
+ hcase = 11
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .true.
+ d14 = .true.
+ d23 = .true.
+ orderexc = 1423
+ case (4)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 11
+ id_blockJ = 11
+ hcase = 5
+ pcase = 1
+ actcase = 0
+ lintx = .true.
+ nsumact = nelact+1
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .true.
+ orderexc = 1423
+ case (5)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 11
+ id_blockJ = 11
+ hcase = 11
+ pcase = 1
+ actcase = 0
+ lintx = .true.
+ nsumact = nelact+1
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .true.
+ orderexc = 1423
+ case (6)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (7)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 5
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (8)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 11
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (9)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 5
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = nelact
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (10)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 11
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = nelact
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+
+ ! 'aaao'
+ case (11)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 00
+ id_blockJ = 11
+ hcase = 2
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (12)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 00
+ id_blockJ = 11
+ hcase = 2
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = nelact
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (13)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 11
+ id_blockJ = 00
+ hcase = 4
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffJ(1)'
+ x2 = 'diffI(2)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (14)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 11
+ id_blockJ = 00
+ hcase = 4
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = nelact
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (15)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 01
+ id_blockJ = -11
+ hcase = 4
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffJ(1)'
+ x2 = 'diffI(2)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (16)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 01
+ id_blockJ = -11
+ hcase = 4
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = nelact-1
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (17)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -11
+ id_blockJ = 01
+ hcase = 2
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (18)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -11
+ id_blockJ = 01
+ hcase = 2
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = nelact-1
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+
+ ! 'AAAA'
+ case (19)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 00
+ id_blockJ = 00
+ hcase = 1
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (20)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 00
+ id_blockJ = 00
+ hcase = 1
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (21)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 11
+ id_blockJ = 11
+ hcase = 9
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (22)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 11
+ id_blockJ = 11
+ hcase = 9
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (23)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = -11
+ id_blockJ = -11
+ hcase = 1
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (24)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = -11
+ id_blockJ = -11
+ hcase = 1
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-2
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (25)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (26)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = +1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+
+ !'VAOO
+ case (27)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = 11
+ hcase = 9
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (28)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = 11
+ hcase = 5
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (29)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = 11
+ hcase = 11
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (30)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 11
+ id_blockJ = 01
+ hcase = 9
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (31)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 11
+ id_blockJ = 01
+ hcase = 5
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (32)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 11
+ id_blockJ = 01
+ hcase = 11
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+
+
+ !'VAAO'
+ case (33)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 00
+ id_blockJ = 01
+ hcase = 2
+ pcase = 2
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p3'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (34)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 00
+ id_blockJ = 01
+ hcase = 2
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (35)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 00
+ hcase = 4
+ pcase = 4
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p1'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (36)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 00
+ hcase = 4
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (37)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 11
+ id_blockJ = -11
+ hcase = 4
+ pcase = 2
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (38)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = -11
+ id_blockJ = 11
+ hcase = 2
+ pcase = 4
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+
+ ! 'VAAA'
+ case (39)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 00
+ id_blockJ = -11
+ hcase = 1
+ pcase = 2
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (40)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 00
+ id_blockJ = -11
+ hcase = 1
+ pcase = 2
+ actcase = 1
+ lintx = .false.
+ nsumact = nelact-1
+ sign = +1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (41)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -11
+ id_blockJ = 00
+ hcase = 1
+ pcase = 4
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (42)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -11
+ id_blockJ = 00
+ hcase = 1
+ pcase = 4
+ actcase = 1
+ lintx = .false.
+ nsumact = nelact-1
+ sign = +1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (43)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 01
+ id_blockJ = 11
+ hcase = 9
+ pcase = 4
+ actcase = 1
+ lintx = .false.
+ nsumact = nelact
+ sign = +1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (44)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 01
+ id_blockJ = 11
+ hcase = 9
+ pcase = 4
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (45)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 11
+ id_blockJ = 01
+ hcase = 9
+ pcase = 2
+ actcase = 1
+ lintx = .false.
+ nsumact = nelact
+ sign = +1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (46)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 11
+ id_blockJ = 01
+ hcase = 9
+ pcase = 2
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = +1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 'diffI(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+
+ ! 'VVAA'
+ case (47)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -11
+ id_blockJ = -11
+ hcase = 1
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (48)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -11
+ id_blockJ = -11
+ hcase = 1
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (49)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -11
+ id_blockJ = -11
+ hcase = 1
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (50)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -11
+ id_blockJ = -11
+ hcase = 1
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = nelact-1
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (51)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -11
+ id_blockJ = -11
+ hcase = 1
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = nelact-1
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (52)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (53)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (54)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (55)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = nelact
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (56)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = nelact
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (57)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 5
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (58)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 11
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (59)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (60)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 9
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (61)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 5
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (62)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 11
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (63)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 5
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (64)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 01
+ id_blockJ = 01
+ hcase = 11
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (65)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = -11
+ hcase = 4
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x2 = 'p1'
+ x1 = 'p1'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (66)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = -11
+ hcase = 4
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x2 = 'p1'
+ x1 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (67)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = -11
+ hcase = 4
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x2 = 'p1'
+ x1 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (68)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -11
+ id_blockJ = 01
+ hcase = 2
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x2 = 'p1'
+ x1 = 'p1'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (69)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -11
+ id_blockJ = 01
+ hcase = 2
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (70)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -11
+ id_blockJ = 01
+ hcase = 2
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = +1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (71)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (72)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (73)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (74)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (75)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (76)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (77)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (78)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (79)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (80)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (81)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (82)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (83)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (84)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (85)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 16
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (86)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 18
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (87)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 21
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (88)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 23
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (89)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 26
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (90)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 29
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (91)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 16
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (92)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 18
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (93)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 21
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (94)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 23
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (95)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 26
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (96)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 29
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (97)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (98)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (99)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (100)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (101)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (102)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 22
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (103)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 16
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (104)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 18
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (105)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 21
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (106)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 23
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (107)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 26
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (108)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 29
+ pcase = 1
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (109)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 16
+ pcase = 1
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (110)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 18
+ pcase = 1
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (111)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 21
+ pcase = 1
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (112)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 23
+ pcase = 1
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (113)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 26
+ pcase = 1
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (114)
+ intkind = 'aaoo'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 29
+ pcase = 1
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (115)
+ intkind = 'aoao'
+ intkindx = 'aoao'
+ id_blockI = 00
+ id_blockJ = 20
+ hcase = 3
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (116)
+ intkind = 'aoao'
+ intkindx = 'aoao'
+ id_blockI = 20
+ id_blockJ = 00
+ hcase = 13
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (117)
+ intkind = 'aoao'
+ intkindx = 'aoao'
+ id_blockI = 02
+ id_blockJ = -20
+ hcase = 13
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (118)
+ intkind = 'aoao'
+ intkindx = 'aoao'
+ id_blockI = -20
+ id_blockJ = 02
+ hcase = 3
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (119)
+ intkind = 'aoao'
+ intkindx = 'aoao'
+ id_blockI = 12
+ id_blockJ = -11
+ hcase = 13
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (120)
+ intkind = 'aoao'
+ intkindx = 'aoao'
+ id_blockI = -11
+ id_blockJ = 12
+ hcase = 3
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (121)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 7
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (122)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 10
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (123)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 7
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (124)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 10
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (125)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 20
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (126)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 28
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (127)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 20
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 2314
+ case (128)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 28
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 2314
+ case (129)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (130)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (131)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 3214
+ case (132)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 3214
+ case (133)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (134)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (135)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (136)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (137)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 7
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (138)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 10
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (139)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 7
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (140)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 10
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (141)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 20
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (142)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 28
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (143)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 20
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 3214
+ case (144)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 28
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 3214
+ case (145)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (146)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 3214
+ case (147)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (148)
+ intkind = 'aaao'
+ intkindx = 'aaao'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (149)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (150)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (151)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 9
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (152)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (153)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (154)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (155)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 22
+ pcase = 1
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (156)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 22
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (157)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 22
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(2)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (158)
+ intkind = 'aaaa'
+ intkindx = 'aaaa'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-3
+ sign = 1
+ x1 = 'andIJ(k)'
+ x2 = 'andIJ(k)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (159)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (160)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (161)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (162)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (163)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (164)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (165)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 15
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (166)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 17
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (167)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 19
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (168)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 25
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (169)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 27
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (170)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 31
+ pcase = 22
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (171)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 16
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (172)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 18
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (173)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 21
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (174)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 23
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (175)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 26
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (176)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 29
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (177)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 15
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (178)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 17
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (179)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 19
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (180)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 25
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (181)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 27
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (182)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 31
+ pcase = 9
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (183)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 16
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (184)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 18
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (185)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 21
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (186)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 23
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (187)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 26
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (188)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 29
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 't1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (189)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 15
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (190)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 17
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (191)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 19
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (192)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 25
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (193)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 27
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (194)
+ intkind = 'oooo'
+ intkindx = 'oooo'
+ id_blockI = 20
+ id_blockJ = 20
+ hcase = 31
+ pcase = 1
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 't1'
+ x2 = 't3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (195)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 16
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (196)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 18
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (197)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 21
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (198)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 23
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (199)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 26
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (200)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 29
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (201)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 15
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (202)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 17
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (203)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 19
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (204)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 25
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (205)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 27
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (206)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 31
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (207)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 16
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (208)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 18
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (209)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 21
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (210)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 23
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (211)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 26
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (212)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 29
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (213)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 15
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (214)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 17
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (215)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 19
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (216)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 25
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (217)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 27
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (218)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 31
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (219)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 16
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (220)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 18
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (221)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 21
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (222)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 23
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (223)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 26
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (224)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 29
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'p4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (225)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 15
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (226)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 17
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (227)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 19
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (228)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 25
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (229)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 27
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (230)
+ intkind = 'vvvv'
+ intkindx = 'vvvv'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 31
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'p4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (231)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 7
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffJ(1)'
+ x2 = 't4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (232)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 10
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (233)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 6
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (234)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 8
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (235)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 12
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (236)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 20
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (237)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 28
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (238)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 14
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (239)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 24
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (240)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 30
+ pcase = 9
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (241)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (242)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (243)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 14
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (244)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 24
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (245)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 30
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (246)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffJ(1)'
+ x2 = 't4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (247)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (248)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 6
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1432
+ case (249)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 8
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1432
+ case (250)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 12
+ pcase = 22
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1432
+ case (251)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 7
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffJ(1)'
+ x2 = 't4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (252)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 10
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (253)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 6
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1432
+ case (254)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 8
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1432
+ case (255)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 11
+ id_blockJ = 20
+ hcase = 12
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffJ(1)'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1432
+ case (256)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 20
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (257)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 28
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'diffI(1)'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (258)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 14
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (259)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 24
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (260)
+ intkind = 'aooo'
+ intkindx = 'aooo'
+ id_blockI = 20
+ id_blockJ = 11
+ hcase = 30
+ pcase = 1
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'diffI(1)'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .true.
+ d14 = .false.
+ d23 = .true.
+ orderexc = 1324
+ case (261)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 7
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (262)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 10
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (263)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 7
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (264)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 10
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (265)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 20
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (266)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 28
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (267)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 20
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (268)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 28
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (269)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 20
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (270)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 28
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (271)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 20
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (272)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 28
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (273)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 7
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (274)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 10
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (275)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 7
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (276)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 10
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (277)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 22
+ pcase = 4
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (278)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 22
+ pcase = 4
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (279)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 22
+ pcase = 2
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (280)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 22
+ pcase = 2
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (281)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 7
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (282)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 10
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (283)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 7
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (284)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 10
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (285)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 20
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (286)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 28
+ actcase = 1
+ lintx = .false.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (287)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 20
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (288)
+ intkind = 'vaaa'
+ intkindx = 'vaaa'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 28
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (289)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (290)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (291)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (292)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (293)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (294)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (295)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (296)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (297)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (298)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (299)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (300)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (301)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (302)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (303)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (304)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (305)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (306)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (307)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (308)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (309)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (310)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (311)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (312)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (313)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (314)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (315)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (316)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (317)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (318)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (319)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (320)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (321)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (322)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (323)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (324)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (325)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (326)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (327)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (328)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (329)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (330)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (331)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (332)
+ intkind = 'vvaa'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = -20
+ hcase = 1
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-2
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'andIJ(k)'
+ x4 = 'andIJ(k)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (333)
+ intkind = 'vava'
+ intkindx = 'vava'
+ id_blockI = 00
+ id_blockJ = -20
+ hcase = 1
+ pcase = 3
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'p4'
+ x4 = 'diffI(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (334)
+ intkind = 'vava'
+ intkindx = 'vava'
+ id_blockI = -20
+ id_blockJ = 00
+ hcase = 1
+ pcase = 13
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'p2'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (335)
+ intkind = 'vava'
+ intkindx = 'vava'
+ id_blockI = 02
+ id_blockJ = 20
+ hcase = 22
+ pcase = 13
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'p2'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (336)
+ intkind = 'vava'
+ intkindx = 'vava'
+ id_blockI = 20
+ id_blockJ = 02
+ hcase = 22
+ pcase = 3
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'p4'
+ x4 = 'diffI(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (337)
+ intkind = 'vava'
+ intkindx = 'vava'
+ id_blockI = 11
+ id_blockJ = -12
+ hcase = 9
+ pcase = 3
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'p4'
+ x4 = 'diffI(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (338)
+ intkind = 'vava'
+ intkindx = 'vava'
+ id_blockI = -12
+ id_blockJ = 11
+ hcase = 9
+ pcase = 13
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'p2'
+ x4 = 'diffJ(2)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (339)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (340)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (341)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (342)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (343)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (344)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 22
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (345)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (346)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (347)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (348)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (349)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (350)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (351)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (352)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (353)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (354)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (355)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (356)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (357)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (358)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (359)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (360)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (361)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (362)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (363)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (364)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (365)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (366)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (367)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (368)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (369)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (370)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (371)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (372)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (373)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (374)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (375)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (376)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (377)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (378)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (379)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (380)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (381)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 16
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (382)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 18
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (383)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 21
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (384)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 23
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (385)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 26
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't4'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (386)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 02
+ hcase = 29
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (387)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (388)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 22
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (389)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 16
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (390)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 18
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (391)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 21
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (392)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 23
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (393)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 26
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (394)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 29
+ pcase = 9
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (395)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 16
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (396)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 18
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (397)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 21
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (398)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 23
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (399)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 26
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (400)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 29
+ pcase = 5
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (401)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 16
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (402)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 18
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (403)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 21
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (404)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 23
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (405)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 26
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (406)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = 12
+ id_blockJ = 12
+ hcase = 29
+ pcase = 11
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (407)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (408)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (409)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (410)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (411)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (412)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 9
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (413)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (414)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 22
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (415)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (416)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (417)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (418)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (419)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (420)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 5
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (421)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 16
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (422)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 18
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (423)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 21
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (424)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 23
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (425)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 26
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (426)
+ intkind = 'vvoo'
+ intkindx = 'vovo'
+ id_blockI = -12
+ id_blockJ = -12
+ hcase = 11
+ pcase = 29
+ actcase = 0
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (427)
+ intkind = 'vovo'
+ intkindx = 'vovo'
+ id_blockI = 00
+ id_blockJ = 02
+ hcase = 3
+ pcase = 3
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 'p4'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (428)
+ intkind = 'vovo'
+ intkindx = 'vovo'
+ id_blockI = 02
+ id_blockJ = 00
+ hcase = 13
+ pcase = 13
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 'p2'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (429)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 7
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p3'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (430)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 10
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p4'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (431)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 7
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p3'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (432)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 10
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (433)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 6
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (434)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 8
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (435)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 12
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (436)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 6
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (437)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 8
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (438)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 12
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (439)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 20
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (440)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 28
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (441)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 20
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (442)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 28
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (443)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 14
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (444)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 24
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (445)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 30
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (446)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 14
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (447)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 24
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (448)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 30
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (449)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 7
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p3'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (450)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 10
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (451)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 6
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (452)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 8
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (453)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 12
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (454)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 20
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (455)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 28
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (456)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 14
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (457)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 24
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (458)
+ intkind = 'vvvo'
+ intkindx = 'vvvo'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 30
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (459)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 7
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p3'
+ x4 = 'diffI(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (460)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 10
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (461)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 6
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (462)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 8
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (463)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 12
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (464)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 20
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (465)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 28
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (466)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 14
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (467)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 24
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (468)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 30
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (469)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 20
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (470)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 28
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (471)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 14
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (472)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 24
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (473)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 30
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (474)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 7
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p3'
+ x4 = 'diffI(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (475)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 10
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (476)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 6
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (477)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 8
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (478)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 12
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (479)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 7
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p3'
+ x4 = 'diffI(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (480)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 10
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (481)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 6
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (482)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 8
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (483)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -11
+ id_blockJ = -20
+ hcase = 1
+ pcase = 12
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p4'
+ x4 = 'diffI(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (484)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 20
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (485)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 28
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p2'
+ x3 = 'p1'
+ x4 = 'diffJ(1)'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (486)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 14
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (487)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 24
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (488)
+ intkind = 'vvva'
+ intkindx = 'vvva'
+ id_blockI = -20
+ id_blockJ = -11
+ hcase = 1
+ pcase = 30
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'p2'
+ x4 = 'diffJ(1)'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (489)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 7
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p3'
+ x2 = 't4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (490)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 10
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p4'
+ x2 = 't4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (491)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 7
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (492)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 10
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p4'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (493)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 6
+ pcase = 7
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (494)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 8
+ pcase = 7
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (495)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 12
+ pcase = 7
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (496)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 6
+ pcase = 10
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (497)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 8
+ pcase = 10
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (498)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 12
+ pcase = 10
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (499)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 20
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (500)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 28
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (501)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 20
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (502)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 28
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (503)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 14
+ pcase = 20
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1342
+ case (504)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 24
+ pcase = 20
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1342
+ case (505)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 30
+ pcase = 20
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1342
+ case (506)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 14
+ pcase = 28
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1342
+ case (507)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 24
+ pcase = 28
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1342
+ case (508)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 30
+ pcase = 28
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1342
+ case (509)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 7
+ pcase = 2
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p3'
+ x2 = 't4'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (510)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 10
+ pcase = 2
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (511)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 6
+ pcase = 2
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (512)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 8
+ pcase = 2
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (513)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 12
+ pcase = 2
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 't4'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (514)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 20
+ pcase = 4
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 't2'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (515)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 28
+ pcase = 4
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 't2'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (516)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 14
+ pcase = 4
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (517)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 24
+ pcase = 4
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (518)
+ intkind = 'vooo'
+ intkindx = 'vooo'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 30
+ pcase = 4
+ actcase = 0
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 't3'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (519)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (520)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 9
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (521)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 5
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (522)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 11
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (523)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 5
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (524)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 01
+ id_blockJ = -12
+ hcase = 11
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (525)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (526)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 9
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (527)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 5
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (528)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 11
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (529)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 5
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (530)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = -12
+ id_blockJ = 01
+ hcase = 11
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (531)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (532)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 22
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (533)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 16
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (534)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 18
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (535)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 21
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (536)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 23
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (537)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 26
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (538)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 29
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (539)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 16
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (540)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 18
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (541)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 21
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (542)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 23
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (543)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 26
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (544)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = 12
+ hcase = 29
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (545)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (546)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 22
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (547)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 16
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (548)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 18
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (549)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 21
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (550)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 23
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (551)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 26
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (552)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 29
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (553)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 16
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (554)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 18
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (555)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 21
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (556)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 23
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (557)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 26
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (558)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 02
+ hcase = 29
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (559)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 22
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (560)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 16
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (561)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 18
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (562)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 21
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (563)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 23
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (564)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 26
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (565)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 20
+ hcase = 29
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (566)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 22
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = -1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'ti'
+ x4 = 'ti'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (567)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 16
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (568)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 18
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (569)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 21
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (570)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 23
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't1'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (571)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 26
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (572)
+ intkind = 'vaoo'
+ intkindx = 'voao'
+ id_blockI = 20
+ id_blockJ = 12
+ hcase = 29
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 't2'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (573)
+ intkind = 'voao'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = -11
+ hcase = 13
+ pcase = 20
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 't1'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (574)
+ intkind = 'voao'
+ intkindx = 'voao'
+ id_blockI = 02
+ id_blockJ = -11
+ hcase = 13
+ pcase = 28
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (575)
+ intkind = 'voao'
+ intkindx = 'voao'
+ id_blockI = -11
+ id_blockJ = 02
+ hcase = 3
+ pcase = 7
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (576)
+ intkind = 'voao'
+ intkindx = 'voao'
+ id_blockI = -11
+ id_blockJ = 02
+ hcase = 3
+ pcase = 10
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 't3'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (577)
+ intkind = 'voao'
+ intkindx = 'voao'
+ id_blockI = 00
+ id_blockJ = 12
+ hcase = 3
+ pcase = 2
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 't3'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (578)
+ intkind = 'voao'
+ intkindx = 'voao'
+ id_blockI = 12
+ id_blockJ = 00
+ hcase = 13
+ pcase = 4
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 't1'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1432
+ case (579)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 7
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p3'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (580)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 10
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p4'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (581)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 7
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p3'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (582)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 10
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p4'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (583)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (584)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 7
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (585)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (586)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 01
+ id_blockJ = 02
+ hcase = 10
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (587)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 20
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p2'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (588)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 28
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p1'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (589)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 20
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p2'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (590)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 28
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact
+ sign = -1
+ x1 = 'p1'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (591)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (592)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 20
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (593)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (594)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 02
+ id_blockJ = 01
+ hcase = 28
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (595)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 01
+ id_blockJ = 20
+ hcase = 7
+ pcase = 4
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (596)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 01
+ id_blockJ = 20
+ hcase = 10
+ pcase = 4
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (597)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 20
+ id_blockJ = 01
+ hcase = 20
+ pcase = 2
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (598)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 20
+ id_blockJ = 01
+ hcase = 28
+ pcase = 2
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (599)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 01
+ id_blockJ = -20
+ hcase = 4
+ pcase = 7
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (600)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 01
+ id_blockJ = -20
+ hcase = 4
+ pcase = 10
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (601)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = -20
+ id_blockJ = 01
+ hcase = 2
+ pcase = 20
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (602)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = -20
+ id_blockJ = 01
+ hcase = 2
+ pcase = 28
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (603)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 7
+ pcase = 2
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = -1
+ x1 = 'p3'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (604)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 10
+ pcase = 2
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = -1
+ x1 = 'p3'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (605)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 7
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (606)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 11
+ id_blockJ = 12
+ hcase = 10
+ pcase = 2
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (607)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 20
+ pcase = 4
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = -1
+ x1 = 'p1'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (608)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 28
+ pcase = 4
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact+1
+ sign = -1
+ x1 = 'p1'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (609)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 20
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (610)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = 12
+ id_blockJ = 11
+ hcase = 28
+ pcase = 4
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (611)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 12
+ id_blockJ = -12
+ hcase = 20
+ pcase = 7
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (612)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 12
+ id_blockJ = -12
+ hcase = 28
+ pcase = 7
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (613)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 12
+ id_blockJ = -12
+ hcase = 20
+ pcase = 10
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (614)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = 12
+ id_blockJ = -12
+ hcase = 28
+ pcase = 10
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffI(2)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (615)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = -12
+ id_blockJ = 12
+ hcase = 7
+ pcase = 20
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (616)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = -12
+ id_blockJ = 12
+ hcase = 10
+ pcase = 20
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (617)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = -12
+ id_blockJ = 12
+ hcase = 7
+ pcase = 28
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (618)
+ intkind = 'vaao'
+ intkindx = 'vaao'
+ id_blockI = -12
+ id_blockJ = 12
+ hcase = 10
+ pcase = 28
+ actcase = 2
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffJ(2)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (619)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 7
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = -1
+ x1 = 'p3'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (620)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 10
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = -1
+ x1 = 'p4'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (621)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 7
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (622)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = -11
+ id_blockJ = -12
+ hcase = 2
+ pcase = 10
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p4'
+ x2 = 'diffI(1)'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (623)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 20
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = -1
+ x1 = 'p2'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (624)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 28
+ actcase = 0
+ lintx = .true.
+ nsumact = Nelact-1
+ sign = -1
+ x1 = 'p1'
+ x2 = 'andIJ(k)'
+ x3 = 'andIJ(k)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .false.
+ d23 = .false.
+ orderexc = 1423
+ case (625)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 20
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (626)
+ intkind = 'vaao'
+ intkindx = 'voaa'
+ id_blockI = -12
+ id_blockJ = -11
+ hcase = 4
+ pcase = 28
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1423
+ case (627)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 7
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (628)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 10
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (629)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 7
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (630)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 7
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (631)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 10
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (632)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 01
+ id_blockJ = 12
+ hcase = 10
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (633)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 20
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (634)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 28
+ pcase = 9
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p1'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (635)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 20
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (636)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 20
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (637)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 28
+ pcase = 5
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (638)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 12
+ id_blockJ = 01
+ hcase = 28
+ pcase = 11
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (639)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (640)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (641)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (642)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (643)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (644)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (645)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (646)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 20
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (647)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (648)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (649)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (650)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (651)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (652)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = -12
+ hcase = 28
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (653)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (654)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (655)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (656)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (657)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (658)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (659)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (660)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 7
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (661)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (662)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (663)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (664)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (665)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (666)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 02
+ hcase = 10
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (667)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (668)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (669)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (670)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (671)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (672)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (673)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = -20
+ hcase = 4
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffI(1)'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 2314
+ case (674)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 22
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'pi'
+ x2 = 'pi'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .false.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (675)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 16
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (676)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 18
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (677)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 21
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (678)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 23
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p2'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (679)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 26
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p3'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (680)
+ intkind = 'vvao'
+ intkindx = 'vavo'
+ id_blockI = -20
+ id_blockJ = -12
+ hcase = 2
+ pcase = 29
+ actcase = 1
+ lintx = .true.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'p4'
+ x3 = 'diffJ(1)'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 1324
+ case (681)
+ intkind = 'vavo'
+ intkindx = 'vavo'
+ id_blockI = 00
+ id_blockJ = -12
+ hcase = 2
+ pcase = 3
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (682)
+ intkind = 'vavo'
+ intkindx = 'vavo'
+ id_blockI = -12
+ id_blockJ = 00
+ hcase = 4
+ pcase = 13
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (683)
+ intkind = 'vavo'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = 11
+ hcase = 20
+ pcase = 13
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'p2'
+ x4 = 't1'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (684)
+ intkind = 'vavo'
+ intkindx = 'vavo'
+ id_blockI = 02
+ id_blockJ = 11
+ hcase = 28
+ pcase = 13
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p1'
+ x2 = 'diffJ(1)'
+ x3 = 'p2'
+ x4 = 't2'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (685)
+ intkind = 'vavo'
+ intkindx = 'vavo'
+ id_blockI = 11
+ id_blockJ = 02
+ hcase = 7
+ pcase = 3
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'p4'
+ x4 = 't4'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+ case (686)
+ intkind = 'vavo'
+ intkindx = 'vavo'
+ id_blockI = 11
+ id_blockJ = 02
+ hcase = 10
+ pcase = 3
+ actcase = 1
+ lintx = .false.
+ nsumact = 0
+ sign = 1
+ x1 = 'p3'
+ x2 = 'diffI(1)'
+ x3 = 'p4'
+ x4 = 't3'
+ d12 = .true.
+ d34 = .false.
+ d14 = .true.
+ d23 = .false.
+ orderexc = 3214
+case default
+ call SASS_quit('wrong intcase_id in intcase.f90',6)
+ end select
+
+ call intcase_init(intcases%cases(intcase_id)%p, &
+ intkind, intkindx, id_blockI, id_blockJ, &
+ hcase, pcase, actcase, lintx, nsumact, sign, d12, d34, d14, d23, &
+ x1, x2, x3, x4, orderexc)
+
+ !call wrt_intcase_id(intcases%cases(intcase_id)%p, intcase_id)
+
+ end do
+
+
+ end subroutine intcaselist_init
+
+ !!============================================================
+ !> @brief Free intcase list
+ !> @author Elisa Rebolini
+ !> @date Nov 2018
+ !!
+ !> @param intcase list to be freed
+ !!============================================================
+ subroutine intcaselist_free(intcases)
+
+ type(intcase_list), intent(inout) :: intcases
+
+ integer :: i
+
+ do i = 1, intcases%ncases
+ if (associated(intcases%cases(i)%p)) then
+ deallocate(intcases%cases(i)%p)
+ endif
+ enddo
+
+ deallocate(intcases%cases)
+
+ end subroutine intcaselist_free
+
+ !!============================================================
+ !> @brief Get the id case number
+ !> @author Elisa Rebolini
+ !> @date Nov 2018
+ !!
+ !> @param intcases intcase list
+ !> @param intkind character string for the integral kind
+ !> @param id_blockI Id number for the determinant block I
+ !> @param id_blockJ Id number for the determinant block J
+ !> @param hcase Id number for the hole case
+ !> @param pcase Id number for the particule case
+ !> @param actcase Id number for the active case
+ !> @param[out] id_case Id of the int Case
+ !!============================================================
+ subroutine get_intcase_id(intcases, intkind, id_blockI, id_blockJ, hcase, &
+ pcase, actcase, id_case)
+
+ type(intcase_list), intent(in) :: intcases
+ character(4) :: intkind
+ integer :: id_blockI, id_blockJ
+ integer :: hcase, pcase, actcase
+ integer, intent(out) :: id_case
+
+ logical :: found
+ integer :: i
+ type(intcase), pointer :: a
+ Integer, dimension(100) :: idcasetmp
+
+ found = .false.
+
+ id_case = 0
+
+ do i = 1, intcases%ncases
+ a => intcases%cases(i)%p
+ if ((a%intkind .eq. intkind) .and. (a%id_blockI .eq. id_blockI) .and. &
+ (a%id_blockJ .eq. id_blockJ) .and. (a%hcase .eq. hcase) .and. &
+ (a%pcase .eq. pcase) .and. (a%actcase .eq. actcase)) then
+ found = .true.
+ id_case = i
+ end if
+ enddo
+
+ end subroutine get_intcase_id
+end module utils_intcase
diff --git a/src/cio.c b/src/cio.c
new file mode 100644
index 0000000000000000000000000000000000000000..2ccb85ba725fe996d846b8ffa5f8e83d44906cdd
--- /dev/null
+++ b/src/cio.c
@@ -0,0 +1,311 @@
+/***********************************************************************
+* This file is part of OpenMolcas. *
+* *
+* OpenMolcas is free software; you can redistribute it and/or modify *
+* it under the terms of the GNU Lesser General Public License, v. 2.1. *
+* OpenMolcas is distributed in the hope that it will be useful, but it *
+* is provided "as is" and without any express or implied warranties. *
+* For more details see the full text of the license in the file *
+* LICENSE or in <http://www.gnu.org/licenses/>. *
+* *
+* Copyright (C) 1992, Markus P. Fuelscher *
+* 2012,2013, Victor P. Vysotskiy *
+* 2020, Ignacio Fdez. Galvan *
+***********************************************************************/
+/******************************************************************************/
+/* */
+/* A I X - I / O */
+/* */
+/* The fast I/O calls the following C-langue primitives: */
+/* open, close, read, write, lseek, remove and fsync */
+/* This file includes the FORTRAN to C-language interfaces. */
+/* */
+/*----------------------------------------------------------------------------*/
+/* */
+/* written by: */
+/* M.P. Fuelscher */
+/* University of Lund, Sweden, 1992 */
+/* */
+/*----------------------------------------------------------------------------*/
+/* */
+/* history: Victor P. Vysotskiy, University of Lund, Sweden, 2012-2013 */
+/* - collect all declarations in the 'cio.h' header file */
+/* - thread-safe pwrite/pread IO */
+/* - filesize information via 'c_stat' */
+/* Ignacio Fdez. Galvan, 2020 */
+/* - add c_rename */
+/* */
+/******************************************************************************/
+
+#include <fcntl.h>
+#ifndef _WIN32_
+#include <unistd.h>
+#else
+#include <windows.h>
+#define open _lopen
+#define close _lclose
+#define read _lread
+#define write _lwrite
+#define lseek _llseek
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <sys/uio.h>
+#include "molcastype.h"
+#include "cio.h"
+
+#define MIN(x,y) (x<y? x : y)
+/*--- c_open -----------------------------------------------------------------*/
+INT c_open(Path)
+ char *Path;
+
+{
+
+ INT rc;
+ INT oFlag;
+ INT oMode;
+#ifdef _CRAY_C90_
+ char fn[256];
+ oFlag=O_CREAT|O_RDWR;
+ (void)strcpy(fn,Path);
+ rc = open(fn,oFlag,0644);
+#else
+#ifndef _WIN32_
+ oFlag=O_CREAT|O_RDWR;
+ oMode=S_IRUSR|S_IRGRP|S_IROTH|S_IWUSR;
+ rc = open(Path,oFlag,oMode);
+#else
+ oFlag=OF_READWRITE;
+ rc=open(Path,oFlag);
+#endif
+#endif
+ if(rc<0) {
+ oFlag=O_RDONLY;
+#ifdef _CRAY_C90_
+ rc = open(fn,oFlag);
+#else
+#ifndef _WIN32_
+ rc = open(Path,oFlag);
+#else
+ oFlag=OF_READ;
+ rc=open(Path,oFlag);
+#endif
+#endif
+ }
+
+ return rc;
+
+}
+/*--- c_open_w -----------------------------------------------------------------*/
+INT c_openw(Path)
+ char *Path;
+
+{
+
+ INT rc;
+ INT oFlag;
+ INT oMode;
+#ifdef _CRAY_C90_
+ char fn[256];
+ oFlag=O_CREAT|O_RDWR|O_TRUNC;
+ (void)strcpy(fn,Path);
+ rc = open(fn,oFlag,0644);
+#else
+#ifndef _WIN32_
+ oFlag=O_CREAT|O_RDWR|O_TRUNC;
+ oMode=S_IRUSR|S_IRGRP|S_IROTH|S_IWUSR;
+ rc = open(Path,oFlag,oMode);
+#else
+ oFlag=OF_READWRITE;
+ rc=open(Path,oFlag);
+#endif
+#endif
+ return rc;
+
+}
+
+/*--- c_close ----------------------------------------------------------------*/
+INT c_close(FileDescriptor)
+ INT *FileDescriptor;
+
+{
+ INT rc;
+ rc = close(*FileDescriptor);
+ return rc;
+}
+
+/*--- c_read -----------------------------------------------------------------*/
+INT c_read(FileDescriptor,Buffer,nBytes)
+ INT *FileDescriptor;
+ char *Buffer;
+ INT *nBytes;
+
+{
+ INT rc=0;
+ INT bfrblk=1024*1024;
+ INT i=0;
+ INT remains;
+ INT readlength;
+ remains=*nBytes;
+ while (remains > 0){
+ readlength = MIN(bfrblk,remains);
+ rc = (INT)read(*FileDescriptor,(void *)(Buffer+i),(size_t)(readlength));
+ if ( rc == readlength ) { i = i+readlength; rc = i; remains = remains - bfrblk;}
+ else { rc = 0; return rc ;}
+ }
+ return rc;
+}
+
+
+/*--- c_pread -----------------------------------------------------------------*/
+INT c_pread(INT *FileDescriptor,char *Buffer,INT *nBytes,INT *Offset) {
+ INT rc=0;
+ rc=(INT) pread((int) *FileDescriptor,(void *) Buffer, (size_t) *nBytes, (off_t) *Offset);
+ return rc;
+}
+
+
+
+/*--- c_write ----------------------------------------------------------------*/
+INT c_write(FileDescriptor,Buffer,nBytes)
+ INT *FileDescriptor;
+ char *Buffer;
+ INT *nBytes;
+
+{
+ INT rc=0;
+ INT bfrblk=1024*1024;
+ INT i=0;
+ INT remains;
+ INT writelength;
+ remains=*nBytes;
+ while (remains > 0){
+ writelength = MIN(bfrblk,remains);
+ rc = (INT)write(*FileDescriptor,(void *)(Buffer+i),(size_t)(writelength));
+ if ( rc == writelength ) { i = i+writelength; rc = i; remains = remains - bfrblk;}
+ else { rc = 0; return rc ;}
+ }
+ return rc;
+}
+
+
+/*--- c_pwrite ----------------------------------------------------------------*/
+INT c_pwrite(INT *FileDescriptor,char *Buffer,INT *nBytes, INT *Offset) {
+INT rc=0;
+
+ rc = (INT) pwrite((int) *FileDescriptor,(void *)(Buffer),(size_t)(*nBytes), (off_t) *Offset);
+ return rc;
+}
+
+
+/*--- c_lseek ----------------------------------------------------------------*/
+INT c_lseek(FileDescriptor,Offset)
+ INT *FileDescriptor;
+ INT *Offset;
+
+{
+#ifdef _WIN32_
+typedef long off_t;
+#endif
+ INT rc;
+ rc = (INT)lseek(*FileDescriptor,(off_t)(*Offset),SEEK_SET);
+ return rc;
+}
+
+/*--- c_remove ---------------------------------------------------------------*/
+INT c_remove(FileName)
+ char *FileName;
+
+{
+ INT rc;
+#ifdef _CAPITALS_
+ char fn[256];
+#endif
+
+#ifdef _CAPITALS_
+ (void)strcpy(fn,FileName);
+ rc = remove(fn);
+#else
+#ifndef _WIN32_
+ rc = remove(FileName);
+#else
+ rc = DeleteFile(FileName);
+#endif
+#endif
+ return rc;
+}
+
+/*--- c_fsync ----------------------------------------------------------------*/
+INT c_fsync(FileDescriptor)
+ INT *FileDescriptor;
+
+{
+ INT rc;
+#ifndef _WIN32_
+ rc = fsync(*FileDescriptor);
+#else
+ rc=0;
+#endif
+ return rc;
+}
+
+/*--- c_copy ----------------------------------------------------------------*/
+INT c_copy(FileDescriptor1, FileDescriptor2)
+ INT *FileDescriptor1, *FileDescriptor2;
+{
+ INT rc;
+ char *Buffer;
+ struct stat stat;
+ size_t rce;
+
+ rc=fstat(*FileDescriptor1, &stat);
+
+ rce=stat.st_size;
+ Buffer=(char*) malloc(sizeof(char)*(rce+1));
+ rc = (INT)read(*FileDescriptor1,(void *)(Buffer),(size_t)(rce));
+ rc = (INT)write(*FileDescriptor2,(void *)(Buffer),(size_t)(rce));
+ free(Buffer);
+ return rc;
+}
+
+/*--- c_stat ----------------------------------------------------------------*/
+INT c_stat(FileDescriptor)
+ INT *FileDescriptor;
+{
+ INT rc;
+ struct stat flstat;
+ off_t fsize;
+
+ rc=fstat(*FileDescriptor, &flstat);
+ (void)rc;
+ fsize=flstat.st_size;
+ return fsize;
+}
+
+/*--- c_rename --------------------------------------------------------------*/
+INT c_rename(FileName,NewName)
+ char *FileName;
+ char *NewName;
+
+{
+ INT rc;
+#ifdef _CAPITALS_
+ char fn[256];
+ char nn[256];
+#endif
+
+#ifdef _CAPITALS_
+ (void)strcpy(fn,FileName);
+ (void)strcpy(nn,FileName);
+ rc = rename(fn,nn);
+#else
+#ifndef _WIN32_
+ rc = rename(FileName,NewName);
+#else
+ rc = MoveFile(FileName,NewName);
+#endif
+#endif
+ return rc;
+}
diff --git a/src/cio.h b/src/cio.h
new file mode 100644
index 0000000000000000000000000000000000000000..e3f43dbc5a6d50790722fe07908f7914589cad69
--- /dev/null
+++ b/src/cio.h
@@ -0,0 +1,75 @@
+/***********************************************************************
+* This file is part of OpenMolcas. *
+* *
+* OpenMolcas is free software; you can redistribute it and/or modify *
+* it under the terms of the GNU Lesser General Public License, v. 2.1. *
+* OpenMolcas is distributed in the hope that it will be useful, but it *
+* is provided "as is" and without any express or implied warranties. *
+* For more details see the full text of the license in the file *
+* LICENSE or in <http://www.gnu.org/licenses/>. *
+* *
+* Copyright (C) 2012-2013, Victor P. Vysotskiy *
+* 2020, Ignacio Fdez. Galvan *
+***********************************************************************/
+/**************************************************************************/
+/* */
+/* THE NATIVE MOLCAS'S AIX IO LAYER */
+/* */
+/* Just a header file */
+/* */
+/*------------------------------------------------------------------------*/
+/* */
+/* Author: Victor P. Vysotskiy */
+/* Lund University, Sweden */
+/* Written: 2012-2013 */
+/* */
+/*------------------------------------------------------------------------*/
+/* */
+/* History: */
+/* */
+/**************************************************************************/
+#ifdef _CAPITALS_
+#define c_open C_OPEN
+#define c_openw C_OPENW
+#define c_close C_CLOSE
+#define c_read C_READ
+#define c_pread C_PREAD
+#define c_write C_WRITE
+#define c_pwrite C_PWRITE
+#define c_lseek C_LSEEK
+#define c_remove C_REMOVE
+#define c_fsync C_FSYNC
+#define c_copy C_COPY
+#define c_stat C_STAT
+#define c_rename C_RENAME
+#else
+#ifndef ADD_
+#define c_open c_open_
+#define c_openw c_openw_
+#define c_close c_close_
+#define c_read c_read_
+#define c_pread c_pread_
+#define c_write c_write_
+#define c_pwrite c_pwrite_
+#define c_lseek c_lseek_
+#define c_remove c_remove_
+#define c_fsync c_fsync_
+#define c_copy c_copy_
+#define c_stat c_stat_
+#define c_rename c_rename_
+#endif
+#endif
+
+INT c_open(char *Path);
+INT c_openw(char *Path);
+INT c_close(INT *FileDescriptor);
+INT c_read(INT *FileDescriptor,char *Buffer,INT *nBytes);
+INT c_pread(INT *FileDescriptor,char *Buffer,INT *nBytes,INT *Offset);
+INT c_write(INT *FileDescriptor,char *Buffer,INT *nBytes);
+INT c_pwrite(INT *FileDescriptor,char *Buffer,INT *nBytes, INT *Offset);
+INT c_lseek(INT *FileDescriptor,INT *Offset);
+INT c_remove(char *FileName);
+INT c_fsync(INT *FileDescriptor);
+INT c_copy(INT *FileDescriptor1, INT *FileDescriptor2);
+INT c_stat(INT *FileDescriptor);
+INT c_rename(char *FileName,char *NewName);
diff --git a/src/compute_hv.F90 b/src/compute_hv.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c7459ac3f1523e1b6dd26c6fbdefc8f041f85eed
--- /dev/null
+++ b/src/compute_hv.F90
@@ -0,0 +1,832 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+module compute_hv
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use typetargetvec
+ use utils_intcase
+ use utils_batch
+#ifdef VAR_NOGEN
+ use blocs_hv
+#else
+ use codegen_hv
+#endif
+
+ implicit none
+
+contains
+
+ !$========================================================================
+ !> @brief Compute Wm = HVm
+ !> @author Elisa Rebolini
+ !> @date June 2018
+ !
+ !> @param[in] Vm_array 2-dim array Vm(ndet,nvec)
+ !> @param[out] Wm_array 2-dim array Wm(ndet,nvec)
+ !> @param fock Fock matrix in the AO basis
+ !> @param hdiag Diagonal elms of the Hamiltonian matrix
+ !> @param rspin List of the spin-ordered active parts of the determinants
+ !> @param det List of blocks of determinants D_m^n
+ !> @param o_info Orbital information
+ !> @param int_info Integral information
+ !> @param v_info Info on the target states
+ !> @param prog_info
+ !> @param nelact Nb of active electrons
+ !> @param ndet Total number of determinants
+ !> @param nvec
+ !> @param hcase_info
+ !> @param pcase_info
+ !> @param hmat
+ !> @param intkindlist
+ !> @param mpilist
+ !$========================================================================
+ subroutine compute_HVm(Vm_array, Wm_array, fock, hdiag, rspin, det, o_info, &
+ int_info, prog_info, nelact, ndet, nvec, &
+ hcase_info, pcase_info, hmat, intkindlist, mpilist, iter)
+
+ Integer, intent(in) :: nelact, ndet, nvec, iter
+ real(kd_dble), dimension(1:ndet,1:nvec), intent(in) :: Vm_array
+ real(kd_dble), dimension(1:ndet,1:nvec), intent(inout) :: Wm_array
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: hmat
+ real(kd_dble), dimension(:), allocatable, intent(in) :: hdiag
+ type(spinrlist), intent(in) :: rspin
+ type(deter_dblocklist), intent(in) :: det
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(prog_infotype), intent(in) :: prog_info
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intkind_H), dimension(:), allocatable , intent(in) :: intkindlist
+ type(int_blockpair_list), intent(in) :: mpilist
+
+ integer :: nintkind, i
+ type(vecM) :: Vm, Wm
+ type(intkind_H) :: intkind
+ type(intcase_list) :: intcases
+ real(kd_dble) :: t1, t2, wt1, wt2
+
+#ifdef VAR_MPI
+ real(kd_dble), dimension(1:ndet,1:nvec) :: Wm_array_mpi
+ real(kd_dble), dimension(1:mpilist%nint_blockpair) :: cputime, wtime
+ type(int_blockpair) :: mpiitem
+ integer :: indx, ierr
+ integer :: nb_cpu, id_cpu
+ integer :: nloop, iloop, indxintkind
+#endif
+
+ call intcaselist_init(intcases, nelact)
+
+#ifdef VAR_NOGEN
+ if (debug) Hmat(:,:) = 0.d0
+#endif
+
+ !Initialisation Vm
+ call vecM_init(Vm,det,nvec)
+ call vecM_from_full(Vm,Vm_array,ndet,nvec)
+
+ !Initialisation Wm
+ call vecM_init(Wm,det,nvec)
+
+ if (prog_info%id_cpu .eq. 0) then
+ ! Ajout de la diagonale
+ call add_diag(Vm, Wm, hdiag, Hmat)
+ endif
+
+#ifdef VAR_MPI
+
+ cputime(:) = 0.d0
+ wtime(:) = 0.d0
+
+ nintkind = mpilist%nint_blockpair
+
+ nb_cpu = prog_info%nb_cpu
+ id_cpu = prog_info%id_cpu
+ nloop = nintkind/nb_cpu
+ do iloop = 1, nloop
+ indx = (iloop - 1)*nb_cpu + id_cpu + 1
+ i = mpilist%indx(indx)
+ mpiitem = mpilist%l(i)
+ indxintkind = mpiitem%indxintkind
+ intkind = intkindlist(indxintkind)
+
+ if (.not.(prog_info%restart) .and. (iter .eq. 1)) then
+ if (mpiitem%indxI .eq. 1) then
+ call compute_HVm_mpiitem(Vm, Wm, intkind, fock, rspin, det, o_info, &
+ int_info, prog_info, nelact, i, &
+ hcase_info, pcase_info, hmat, intcases, mpiitem, cputime, wtime, iter)
+ else
+ !Guess vectors only in D00
+ endif
+ else
+ call compute_HVm_mpiitem(Vm, Wm, intkind, fock, rspin, det, o_info, &
+ int_info, prog_info, nelact, i, &
+ hcase_info, pcase_info, hmat, intcases, mpiitem, cputime, wtime, iter)
+ endif
+ enddo
+
+ if (mod(nintkind,nb_cpu) .ne. 0) then
+ indx = nintkind/nb_cpu*nb_cpu + id_cpu + 1
+
+ if (indx .le. nintkind) then
+
+ i = mpilist%indx(indx)
+ mpiitem = mpilist%l(i)
+ indxintkind = mpiitem%indxintkind
+ intkind = intkindlist(indxintkind)
+
+ if (.not.(prog_info%restart) .and. (iter .eq. 1)) then
+ if (mpiitem%indxI .eq. 1) then
+ call compute_HVm_mpiitem(Vm, Wm, intkind, fock, rspin, det, o_info, &
+ int_info, prog_info, nelact, i, &
+ hcase_info, pcase_info, hmat, intcases, mpiitem, cputime, wtime, iter)
+ endif
+ else
+ call compute_HVm_mpiitem(Vm, Wm, intkind, fock, rspin, det, o_info, &
+ int_info, prog_info, nelact, i, &
+ hcase_info, pcase_info, hmat, intcases, mpiitem, cputime, wtime, iter)
+ endif
+ endif
+ endif
+
+ call vecM_to_full(Wm, Wm_array_mpi, ndet, nvec)
+
+ !if (((prog_info%restart) .and. (iter .eq. 1)) .or. &
+ ! ((.not.prog_info%restart) .and. (iter .eq. 2))) then
+
+ call MPI_ALLREDUCE(cputime, mpilist%cputime, nintkind, &
+ MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)
+ call MPI_ALLREDUCE(wtime, mpilist%wtime, nintkind, &
+ MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)
+
+ call MPI_ALLREDUCE(Wm_array_mpi, Wm_array, ndet*nvec, &
+ MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)
+#else
+ nintkind = int_info%CASS_nintkind
+ do i = 1, nintkind
+
+ intkind = intkindlist(i)
+ call gettime(t1,wt1)
+ call compute_Hvm_intkind(Vm, Wm, intkind, fock, &
+ rspin, det, o_info, int_info, prog_info, nelact, &
+ hcase_info, pcase_info, hmat, intcases)
+ call gettime(t2,wt2)
+
+ end do
+ call vecM_to_full(Wm, Wm_array,ndet,nvec)
+#endif
+
+ !Cleanup
+ call intcaselist_free(intcases)
+ call vecM_free(Vm)
+ call vecM_free(Wm)
+
+ end subroutine compute_HVm
+
+ !$========================================================================
+ !> @brief Compute Wm = HVm for a given MPI item
+ !> @author Elisa Rebolini
+ !> @date Jan 2020
+ !
+ !> @param[in] Vm_array 2-dim array Vm(ndet,nvec)
+ !> @param[out] Wm_array 2-dim array Wm(ndet,nvec)
+ !> @param fock Fock matrix in the AO basis
+ !> @param hdiag Diagonal elms of the Hamiltonian matrix
+ !> @param rspin List of the spin-ordered active parts of the determinants
+ !> @param det List of blocks of determinants D_m^n
+ !> @param o_info Orbital information
+ !> @param int_info Integral information
+ !> @param v_info Info on the target states
+ !> @param nelact Nb of active electrons
+ !> @param ndet Total number of determinants
+ !$========================================================================
+ subroutine compute_HVm_mpiitem(Vm, Wm, intkind, fock, rspin, det, o_info, &
+ int_info, prog_info, nelact, i, &
+ hcase_info, pcase_info, hmat, intcases, mpiitem, cputime, wtime, iter)
+
+ type(vecM), intent(in) :: Vm
+ type(vecM), intent(inout) :: Wm
+ type(intkind_H), intent(in) :: intkind
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: hmat
+ Integer, intent(in) :: nelact, i, iter
+ type(spinrlist), intent(in) :: rspin
+ type(deter_dblocklist), intent(in) :: det
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(prog_infotype), intent(in) :: prog_info
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intcase_list), intent(in) :: intcases
+ type(int_blockpair), intent(in) :: mpiitem
+ real(kd_dble), dimension(:), intent(inout) :: cputime, wtime
+
+ real(kd_dble) :: t1, t2, wt1, wt2, read_time
+
+ call gettime(t1,wt1)
+ call compute_Hvm_intkind_IJ(Vm, Wm, intkind, mpiitem%indxI, &
+ mpiitem%indxJ, mpiitem%spincase, mpiitem%pmin, mpiitem%pmax, fock, &
+ rspin, det, o_info, int_info, prog_info, nelact, &
+ hcase_info, pcase_info, hmat, intcases, read_time)
+ call gettime(t2,wt2)
+
+ cputime(i) = t2-t1
+ wtime(i) = wt2-wt1
+
+ if (prog_info%iprint.gt.0) then
+
+ if ((wt2-wt1) .gt. 1d-12) then
+ write(*,'(3(F12.4,A),2A,I3,4(A,I3),A,I4,A,I3,A, F12.4)') &
+ t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ mpiitem%intkind, ' : D',det%detblock(mpiitem%indxI)%p%name, &
+ ' : D',det%detblock(mpiitem%indxJ)%p%name,' : spin ',&
+ mpiitem%spincase, ' : pmin ', mpiitem%pmin, ' : pmax ', mpiitem%pmax, &
+ ' : Job ',i,' : CPU ',prog_info%id_cpu, ' : Read time ', read_time
+ else
+ write(*,'(3(F12.4,A),2A,I3,4(A,I3),A,I4,A,I3,A, F12.4)') &
+ t2-t1,' : ', wt2-wt1,' : ', 0d0,' : ', &
+ mpiitem%intkind, ' : D',det%detblock(mpiitem%indxI)%p%name, &
+ ' : D',det%detblock(mpiitem%indxJ)%p%name,' : spin ',&
+ mpiitem%spincase, ' : pmin ', mpiitem%pmin, ' : pmax ', mpiitem%pmax, &
+ ' : Job ',i,' : CPU ',prog_info%id_cpu, ' : Read time ', read_time
+ endif
+ endif
+
+ end subroutine compute_HVm_mpiitem
+
+ !$========================================================================
+ !> @brief Compute Wm = HVm for a given blockpair IJ in MPI
+ !> @author Elisa Rebolini
+ !> @date June 2018
+ !
+ !> @param[in] Vm 2-dim array Vm(ndet,nvec)
+ !> @param[out] Wm 2-dim array Wm(ndet,nvec)
+ !> @param fock Fock matrix in the AO basis
+ !> @param hdiag Diagonal elms of the Hamiltonian matrix
+ !> @param rspin List of the spin-ordered active parts of the determinants
+ !> @param det List of blocks of determinants D_m^n
+ !> @param o_info Orbital information
+ !> @param int_info Integral information
+ !> @param v_info Info on the target states
+ !> @param nelact Nb of active electrons
+ !> @param ndet Total number of determinants
+ !$========================================================================
+ subroutine compute_Hvm_intkind_IJ(Vm, Wm, intkind, indxI, indxJ, spincase, pmin, pmax, fock, &
+ rspin, det, o_info, int_info, prog_info, nelact, &
+ hcase_info, pcase_info, hmat, intcases, read_time)
+
+ integer, intent(in) :: nelact, spincase, pmin, pmax
+ type(vecM), intent(in) :: Vm
+ type(vecM), intent(inout) :: Wm
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: hmat
+ type(intkind_H), intent(in) :: intkind
+ type(spinrlist), intent(in) :: rspin
+ type(deter_dblocklist), intent(in) :: det
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(prog_infotype), intent(in) :: prog_info
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intcase_list), intent(in) :: intcases
+ real(kd_dble), intent(out) :: read_time
+
+ real(kd_dble) :: t1, t2, wt1, wt2
+ type(intblock) :: twoint, twointx
+ integer :: indxI, ndetI, spinindxI, indxJ, ndetJ, spinindxJ
+ type(vecMblock), pointer :: VmI, VmJ, WmI, WmJ
+ type(deter_dblock), pointer :: DblockI, DblockJ
+ type(spindetact_list), pointer :: spinrefI, spinrefJ
+
+
+ read_time = 0.d0
+
+ DblockI => det%detblock(indxI)%p
+ ndetI = DblockI%ndet
+
+ if (ndetI.ne.0) then
+
+ !Get the determinant block J
+ DblockJ => det%detblock(indxJ)%p
+ ndetJ = DblockJ%ndet
+
+ if (ndetJ.ne.0) then
+
+ if (intkind%name .ne. 'fock') then
+
+ call gettime(t1,wt1)
+ call get_twoint(twoint, intkind%name, o_info, int_info, prog_info%id_cpu)
+ if (intkind%lintx) then
+ call get_twoint(twointx, intkind%namex, o_info, int_info, prog_info%id_cpu)
+ endif
+ call gettime(t2,wt2)
+
+ read_time = wt2 - wt1
+
+ endif
+
+
+ VmI => Vm%vecblock(indxI)%p
+ WmI => Wm%vecblock(indxI)%p
+ !Get the Active parts for I
+ spinindxI = get_Rspinindx(dblockI%nelCAS)
+ spinrefI => rspin%l(spinindxI)%p
+
+
+ VmJ => Vm%vecblock(indxJ)%p
+ WmJ => Wm%vecblock(indxJ)%p
+ !Get the Active parts for J
+ spinindxJ = get_Rspinindx(dblockJ%nelCAS)
+ spinrefJ => rspin%l(spinindxJ)%p
+
+#ifdef VAR_NOGEN
+ call hv_blocs(VmI, spinrefI, dblockI, indxI, &
+ WmJ, spinrefJ, dblockJ, indxJ, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases, Hmat)
+
+ if (indxI .ne. indxJ) then
+ call hv_blocs(VmJ, spinrefJ, dblockJ, indxJ, &
+ WmI, spinrefI, dblockI, indxI, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases, Hmat)
+ endif
+
+
+#else
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmJ, WmJ, spinrefJ, dblockJ, indxJ, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+#endif
+
+
+
+ if (intkind%name .ne. 'fock') then
+ call intblock_free(twoint)
+ if (intkind%lintx) call intblock_free(twointx)
+ end if
+
+ endif
+ endif
+ end subroutine compute_Hvm_intkind_IJ
+
+ !$========================================================================
+ !> @brief Compute Wm = HVm -- used in the non-MPI case
+ !> @author Elisa Rebolini
+ !> @date June 2018
+ !
+ !> @param[in] Vm 2-dim array Vm(ndet,nvec)
+ !> @param[out] Wm 2-dim array Wm(ndet,nvec)
+ !> @param[in] fock Fock matrix in the AO basis
+ !> @param[inout] hmat (for debug only)
+ !> @param rspin List of the spin-ordered active parts of the determinants
+ !> @param det List of blocks of determinants D_m^n
+ !> @param o_info Orbital information
+ !> @param int_info Integral information
+ !> @param prog_info
+ !> @param nelact Nb of active electrons
+ !> @param hcase_info
+ !> @param pcase_info
+ !> @param intcases
+ !$========================================================================
+ subroutine compute_Hvm_intkind(Vm, Wm, intkind, fock, &
+ rspin, det, o_info, int_info, prog_info, nelact, &
+ hcase_info, pcase_info, hmat, intcases)
+
+ integer, intent(in) :: nelact
+ type(vecM), intent(in) :: Vm
+ type(vecM), intent(inout) :: Wm
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: hmat
+ type(intkind_H), intent(in) :: intkind
+ type(spinrlist), intent(in) :: rspin
+ type(deter_dblocklist), intent(in) :: det
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(prog_infotype), intent(in) :: prog_info
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+
+ type(intblock) :: twoint, twointx
+ integer :: indxI, ndetI, spinindxI, indxJ, ndetJ, spinindxJ, spincase, pmin, pmax
+ type(vecMblock), pointer :: VmI, WmI, VmJ, WmJ, Vmdumb, Wmdumb
+ type(deter_dblock), pointer :: DblockI, DblockJ
+ type(spindetact_list), pointer :: spinrefI, spinrefJ
+ type(intcase_list) :: intcases
+
+ real(kd_dble) :: t1, t2, wt1, wt2
+
+ logical :: symblock
+
+ pmin = 0
+ pmax = o_info%nligv + o_info%nvirt
+
+ if (intkind%name .ne. 'fock') then
+ call get_twoint(twoint, intkind%name, o_info, int_info, prog_info%id_cpu)
+ if (intkind%lintx) then
+ call get_twoint(twointx, intkind%namex, o_info, int_info, prog_info%id_cpu)
+ endif
+ endif
+
+ do indxI = 1, det%nblock
+ !IndxI = 1
+ DblockI => det%detblock(indxI)%p
+ ndetI = DblockI%ndet
+
+ if (ndetI.ne.0) then
+ VmI => Vm%vecblock(indxI)%p
+ WmI => Wm%vecblock(indxI)%p
+ !Get the Active parts for I
+ spinindxI = get_Rspinindx(dblockI%nelCAS)
+ spinrefI => rspin%l(spinindxI)%p
+
+ !Get the determinant block J
+ !indxI = indxJ
+#ifdef VAR_NOGEN
+
+ call hv_blocs(VmI, spinrefI, dblockI, indxI, &
+ WmI, spinrefI, dblockI, indxI, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases, Hmat)
+#else
+ if (dblockI%nexcVirt .eq. 2) then
+ do spincase = 1, 4
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmI, WmI, spinrefI, dblockI, indxI, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockI%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockI%name,' : spin ', spincase
+ end if
+ flush(667)
+ endif
+ enddo
+ else if (dblockI%nexcVirt .eq. 1) then
+ do spincase = 1, 2
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, Wmdumb, spinrefI, dblockI, indxI, &
+ VmI, WmI, spinrefI, dblockI, indxI, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockI%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockI%name,' : spin ', spincase
+ end if
+ flush(667)
+ endif
+ enddo
+ else
+ spincase = 1
+
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmI, WmI, spinrefI, dblockI, indxI, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockI%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockI%name,' : spin ', spincase
+ endif
+ flush(667)
+ endif
+ endif
+#endif
+
+ !indxI < IndxJ
+ do indxJ = indxI+1, det%nblock
+ !indxJ = 1
+ DblockJ => det%detblock(indxJ)%p
+ ndetJ = DblockJ%ndet
+
+ if (ndetJ.ne.0) then
+ VmJ => Vm%vecblock(indxJ)%p
+ WmJ => Wm%vecblock(indxJ)%p
+
+ !Get the Active parts for J
+ spinindxJ = get_Rspinindx(dblockJ%nelCAS)
+ spinrefJ => rspin%l(spinindxJ)%p
+
+#ifdef VAR_NOGEN
+ ! I < J
+ call hv_blocs(VmI, spinrefI, dblockI, indxI, &
+ WmJ, spinrefJ, dblockJ, indxJ, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases, Hmat)
+ ! I > J
+ call hv_blocs(VmJ, spinrefJ, dblockJ, indxJ, &
+ WmI, spinrefI, dblockI, indxI, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases, Hmat)
+
+
+#else
+ symblock = direct_or_sym(DblockI, DblockJ)
+
+ if (symblock) then
+ if (dblockJ%nexcVirt .eq. 2) then
+ do spincase = 1, 4
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmJ, WmJ, spinrefJ, dblockJ, indxJ, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ endif
+ flush(667)
+ endif
+
+ enddo
+ else if (dblockJ%nexcVirt .eq. 1) then
+ do spincase = 1, 2
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmJ, WmJ, spinrefJ, dblockJ, indxJ, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ endif
+ flush(667)
+ endif
+ enddo
+ else
+ spincase = 1
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmJ, WmJ, spinrefJ, dblockJ, indxJ, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ endif
+ flush(667)
+ endif
+ endif
+ else
+ if (dblockI%nexcVirt .eq. 2) then
+ do spincase = 1, 4
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmJ, WmJ, spinrefJ, dblockJ, indxJ, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ endif
+ flush(667)
+ endif
+ enddo
+ else if (dblockI%nexcVirt .eq. 1) then
+ do spincase = 1, 2
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmJ, WmJ, spinrefJ, dblockJ, indxJ, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ endif
+ flush(667)
+ endif
+ enddo
+ else
+ spincase = 1
+ call gettime(t1,wt1)
+ call hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmJ, WmJ, spinrefJ, dblockJ, indxJ, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+ if (prog_info%iprint .gt. 0) then
+ call gettime(t2,wt2)
+ if (wt2-wt1 .gt. 0) then
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', (t2-t1)/(wt2-wt1),' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ else
+ write(667,*) t2-t1,' : ', wt2-wt1,' : ', 0.0 ,' : ', &
+ intkind%name, ' : D',DblockI%name,' : D',DblockJ%name,' : spin ', spincase
+ endif
+ flush(667)
+ endif
+ endif
+ endif
+#endif
+
+ endif
+ enddo
+ endif
+ enddo
+
+ if (intkind%name .ne. 'fock') then
+ call intblock_free(twoint)
+ if (intkind%lintx) call intblock_free(twointx)
+ end if
+
+ end subroutine compute_Hvm_intkind
+
+
+!!$========================================================================
+ !> @brief add_diag(Vm,Wm)
+ !> @author MBL
+ !> @date November 2018
+ !
+ !> @param[in] Vm, Wm, type vecM, input and output vertors
+ !> @param[in] Add the diagobal elements
+ !> @param[in] Wm = Wm + Vm*hdiag
+ !$========================================================================
+ subroutine add_diag(V,W,hdiag,Hmat)
+ type(vecM), intent(in) :: v
+ type(vecM), intent(inout) :: w
+ real(kd_dble), dimension(:), intent(in) :: hdiag
+ real(kd_dble), dimension(:,:) :: hmat
+
+ type(vecMblock), pointer :: Vblock, Wblock
+ integer :: iblock, isft
+ integer :: idet,ivec,nblocks, ndetblock,nvecblocs
+
+ nblocks = v%ndblock
+
+ isft = 0
+ do iblock = 1, nblocks
+ vblock => v%vecblock(iblock)%p
+ Wblock => W%vecblock(iblock)%p
+ ndetblock = vblock%ndet
+ nvecblocs = vblock%nvec
+
+ if (ndetblock .ne. 0) then
+ do idet = 1, ndetblock
+ do ivec = 1, nvecblocs
+ Wblock%elms(ivec,idet) = Wblock%elms(ivec,idet) &
+ + vblock%elms(ivec,idet)*hdiag(idet+isft)
+#ifdef VAR_NOGEN
+ if (debug) Hmat(idet+isft, idet+isft) = hdiag(idet+isft)
+#endif
+ end do
+ end do
+ isft = isft + ndetblock
+ end if
+ end do
+
+ end subroutine add_diag
+!!$========================================================================
+ !> @brief Compute Wm = HVm from mat (for debug purposes)
+ !> @author MBL
+ !> @date November 2018
+ !
+ !> @param[in] Vm_array 2-dim array Vm(ndet,nvec)
+ !> @param[out] Wm_array 2-dim array Wm(ndet,nvec)
+ !> @param det List of blocks of determinants D_m^n
+ !> @param o_info Orbital information
+ !> @param int_info Integral information
+ !> @param v_info Info on the target states
+ !> @param ndet Total number of determinants
+ !> @param nvec
+ !> @param hmat
+ !$========================================================================
+ subroutine compute_HVm_mat(Vm_array, Wm_array, det, ndet, nvec, hmat)
+
+ integer, intent(in) :: ndet, nvec
+ real(kd_dble), dimension(1:ndet,1:nvec) :: Vm_array, Wm_array
+ real(kd_dble), dimension(:,:), allocatable :: hmat
+ type(deter_dblocklist), intent(in) :: det
+
+ integer :: i
+ type(vecM) :: Vm, Wm
+ type(vecMblock), pointer :: Vmblock, Wmblock
+ integer :: iVmblock, iWmblock, iVmsft, iWmsft
+ integer :: iVmdet,iWmdet,ivec, nblocks, ndetVmblock,ndetWmblock
+
+ !Initialisation Vm
+ call vecM_init(Vm,det,nvec)
+ call vecM_from_full(Vm,Vm_array,ndet,nvec)
+
+ !Initialisation Wm
+ call vecM_init(Wm,det,nvec)
+
+ ! Read Hmat
+ Hmat(:,:) = 0.d0
+ rewind(f_mat)
+ do i = 1, ndet
+ read(f_mat,*) Hmat(i,:)
+ end do
+
+ ! Wm = Hmat*Vm
+ nblocks = Vm%ndblock
+ if (Wm%ndblock.ne.nblocks) &
+ call SASS_quit(">>>> erreur Vm%ndblock .ne. Wm%ndblock",f_output)
+ iWmsft = 0
+ do iWmblock = 1, nblocks
+ Wmblock => Wm%vecblock(iWmblock)%p
+ ndetWmblock = Wmblock%ndet
+ if (nvec.ne.Wmblock%nvec) &
+ call SASS_quit(">>>> erreur Wmndblock%nvec .ne. nvec",f_output)
+ if (ndetWmblock .ne. 0) then
+ iVmsft = 0
+ do iVmblock = 1, nblocks
+ Vmblock => Vm%vecblock(iVmblock)%p
+ ndetVmblock = Vmblock%ndet
+ if (nvec.ne.Vmblock%nvec) &
+ call SASS_quit(">>>> erreur Vmndblock%nvec .ne. nvec",f_output)
+ if (ndetVmblock .ne. 0) then
+ do iWmdet = 1, ndetWmblock
+ do iVmdet = 1, ndetVmblock
+ do ivec = 1, nvec
+ Wmblock%elms(ivec,iWmdet) = Wmblock%elms(ivec,iWmdet) + &
+ Vmblock%elms(ivec,iVmdet)*hmat(iWmdet+iWmsft,iVmdet+iVmsft)
+ end do
+ end do
+ end do
+ iVmsft = iVmsft + ndetVmblock
+ end if
+ end do
+ iWmsft = iWmsft + ndetWmblock
+ end if
+ end do
+
+ call vecM_to_full(Wm, Wm_array,ndet,nvec)
+
+ !Cleanup
+ call vecM_free(Vm)
+ call vecM_free(Wm)
+
+ end subroutine compute_HVm_mat
+
+end module compute_hv
+
+
diff --git a/src/def_files.F90 b/src/def_files.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e4719d54f3159c005df241a6e519dc463cb5369a
--- /dev/null
+++ b/src/def_files.F90
@@ -0,0 +1,338 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+
+!> @brief Generate the file names and open them
+!> @author Marie-Bernadette Lepetit
+subroutine def_files(prog_info)
+!!$ Défini les noms de fichiers
+!!$ Fait les open
+!!$ -------- Donness globales ---------------------------------
+ use files
+ use utils_char
+ use info
+!!$ -------- Donnes locales -----------------------------------
+ implicit none
+
+ type(prog_infotype), intent(inout) :: prog_info
+
+ Integer :: n
+ Character*2 :: file_input
+ Character*3 :: file_output, file_det, file_mat
+ Character*4 :: file_fock, file_bmat, file_ref0, file_mat2, file_bdet, file_info
+ Character*6 :: file_traone, file_traint
+ Character*7 :: file_restart
+ Character*40 :: blan40
+
+ CHARACTER(LEN=8) :: date ! returned values from DATE_AND_TIME()
+ CHARACTER(LEN=10) :: time
+ CHARACTER(LEN=5) :: zone
+ INTEGER,DIMENSION(8) :: values
+
+ logical :: lexist_mat
+ Character*40 :: filename_mat
+!!$============================================================
+!!$ -------- Code ---------------------------------------------
+!!$-----
+!!$ doit definir les noms de fichiers à  associer aux unites logiques
+
+!!$-----
+!!$----- Initialisations
+!!$-----
+ blan40=' '
+ file_input = "in"
+ file_output = "out"
+
+ file_info = "sass"
+ file_ref0 = "ref0"
+
+ file_fock = "fock"
+ file_traone = "TraOne"
+ file_traint = "TraInt"
+
+ file_det = "det"
+ file_bdet = "bdet"
+
+ file_restart= "restart" ! infos pour restart de la procedure de Davidson
+
+ file_bmat = "bmat" !Hamiltonian matrix in binary format
+ file_mat = "mat" !Hamiltonian matrix
+ file_mat2 = "mat2" !Hamiltonian matrix with indices
+
+ !file_hcore = "hcore"
+ !file_cipci = "ref_cipci"
+ !file_rho = "rho" ! Density matrix
+ !file_infomolcas = "info"
+
+!!$-----
+!!$----- Transferts de donnes depuis Molcas ou autre
+!!$-----
+ open(f_input,file="INPUT",form="formatted")
+ call read_sassinp(f_input, prog_info)
+
+ ! Ouverture du fichier de sortie
+ if (prog_info%Yprefix) then
+ call noblancs(prog_info%prefix,n)
+ if (prog_info%id_cpu.eq.0) then
+ open (unit=f_output,file=prog_info%prefix(1:n)//"."//file_output, &
+ form="formatted")
+ endif
+ else
+ if (prog_info%id_cpu.eq.0) then
+ open (f_output,file=file_output,form="formatted")
+ end if
+ endif
+
+ if (prog_info%id_cpu.eq.0) then
+ ! Premières impressions
+ write(f_output,*) '***********************************************'
+ write(f_output,*)
+ write(f_output,*) " Relaxed Selected Excitation (RelaxSE)"
+ write(f_output,*)
+ write(f_output,*) " The RelaxSE project is distributed under https://spdx.org/licenses/LGPL-3.0-or-later.html"
+ write(f_output,*)
+ write(f_output,*) " Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE"
+ write(f_output,*) " Institut Neel, (CNRS), Grenoble, FRANCE"
+ write(f_output,*)
+ write(f_output,*) " Authors: Elisa REBOLINI (ILL) rebolini@ill.fr"
+ write(f_output,*) " Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr"
+ write(f_output,*)
+ write(f_output,*) '***********************************************'
+#ifdef VAR_DEBUG
+ write(f_output,'(A,L1)') ' DEBUG Version', debug
+#else
+ write(f_output,'(A)') ' RELEASE Version'
+#endif
+#ifdef VAR_MPI
+ write(f_output,'(A,I0,A)') ' MPI version - running on ',&
+ prog_info%nb_cpu,' CPUs'
+#endif
+#ifdef VAR_OMP
+ write(f_output,'(A,I0,A)') ' OMP version - running on ',&
+ prog_info%nb_thread,' threads'
+#endif
+ call date_and_time(date, time, zone, values)
+ write(f_output,*) 'Calculation started on ', date(7:8),'-',date(5:6),&
+ '-',date(1:4), ' at ', time(1:2),':',time(3:4)
+ write(f_output,*)
+
+ write(f_output,'(X,2A)') '>>> Method ',prog_info%method
+
+ write(f_output,*) ">>> Ouverture des fichiers"
+ write(f_output,9001) file_output, prog_info%prefix(1:n)//"."//file_output
+ endif
+
+ if (prog_info%Yprefix) then
+ if (prog_info%iprint .gt. 1) then
+ open (f_fock,file=prog_info%prefix(1:n)//"."//file_fock,&
+ form="formatted")
+ endif
+ open (f_ref0,file=prog_info%prefix(1:n)//"."//file_ref0,&
+ form="formatted")
+ open (f_det,file=prog_info%prefix(1:n)//"."//file_det,&
+ form="formatted")
+ open (f_bdet,file=prog_info%prefix(1:n)//"."//file_bdet,&
+ form="unformatted")
+ open (f_info,file=prog_info%prefix(1:n)//"."//file_info,&
+ form="unformatted")
+ open (f_restart,file=prog_info%prefix(1:n)//"."//file_restart,&
+ form="unformatted")
+
+ if (prog_info%lreadHmat) then
+ write(filename_mat,'(3A)') prog_info%prefix(1:n),".",file_mat
+ inquire(file=filename_mat, exist=lexist_mat)
+ if (.not. lexist_mat) &
+ call SASS_quit('lreadHmat requires in .mat file in input',f_output)
+ endif
+
+ open (f_mat,file=prog_info%prefix(1:n)//"."//file_mat,form="formatted")
+ open (f_mat2,file=prog_info%prefix(1:n)//"."//file_mat2,form="formatted")
+ open (f_bmat,file=prog_info%prefix(1:n)//"."//file_bmat,form="unformatted")
+
+!!$ if (prog_info%prt_cipci) then
+!!$ open (f_cipci,file=prog_info%prefix(1:n)//"."//file_cipci, &
+!!$ form="formatted")
+!!$ end if
+
+
+ if (prog_info%id_cpu.eq.0) then
+ if (prog_info%iprint .gt. 1) then
+ write(f_output,9001) file_fock, prog_info%prefix(1:n)//"."//file_fock
+ endif
+ write(f_output,9001) file_ref0, prog_info%prefix(1:n)//"."//file_ref0
+ write(f_output,9001) file_det, prog_info%prefix(1:n)//"."//file_det
+ write(f_output,9001) file_bdet, prog_info%prefix(1:n)//"."//file_bdet
+ write(f_output,9001) file_info, prog_info%prefix(1:n)//"."//file_info
+ write(f_output,9001) file_restart, prog_info%prefix(1:n)//"."//file_restart
+ write(f_output,9001) file_mat, prog_info%prefix(1:n)//"."//file_mat
+ write(f_output,9001) file_mat2, prog_info%prefix(1:n)//"."//file_mat2
+ write(f_output,9001) file_bmat, prog_info%prefix(1:n)//"."//file_bmat
+
+!!$ if (prog_info%prt_cipci) then
+!!$ write(f_output,9001) file_cipci, prog_info%prefix(1:n)//"."//file_cipci
+!!$ endif
+ endif
+ else
+ if (prog_info%iprint .gt. 1) then
+ open (f_fock,file=file_fock,form="formatted")
+ endif
+ open (f_ref0,file=file_ref0,form="formatted")
+ open (f_det,file=file_det,form="formatted")
+ open (f_bdet,file=file_bdet,form="unformatted")
+ open (f_info,file=file_info,form="unformatted")
+ open (f_restart,file=file_restart,form="unformatted")
+
+ open (f_mat,file=file_mat,form="formatted")
+ open (f_mat2,file=file_mat2,form="formatted")
+ open (f_bmat,file=file_bmat,form="unformatted")
+!!$ if (prog_info%prt_cipci) then
+!!$ open (f_cipci,file=file_cipci,form="formatted")
+!!$ endif
+
+ if (prog_info%id_cpu.eq.0) then
+ if (prog_info%iprint .gt. 1) then
+ write(f_output,9001) file_fock, file_fock
+ endif
+ write(f_output,9001) file_ref0, file_ref0
+ write(f_output,9001) file_det, file_det
+ write(f_output,9001) file_bdet, file_bdet
+ write(f_output,9001) file_info, file_info
+ write(f_output,9001) file_restart, file_restart
+ write(f_output,9001) file_mat, file_mat
+ write(f_output,9001) file_mat2, file_mat2
+ write(f_output,9001) file_bmat, file_bmat
+
+!!$ if (prog_info%Yprefix) then
+!!$ write(f_output,9001) file_cipci, file_cipci
+!!$ endif
+ endif
+ end if
+
+
+
+!!$====================================================================
+9001 format(a5," :",a80)
+End subroutine def_files
+
+
+!$====================================================================
+!> @brief Read the SASS input and store it in the prog_info
+!> @author Elisa Rebolini
+!> @date Oct 2017
+!
+!> @param[in] iunit Input file unit
+!> @param[inout] prog_info Type for all program info
+!$====================================================================
+subroutine read_sassinp(iunit, prog_info)
+
+ use dimensions
+ !use donnees
+ use utils_char
+ use info
+
+ implicit none
+
+ integer, intent(in) :: iunit
+ type(prog_infotype), intent(inout) :: prog_info
+
+ Character*40 :: blan40
+ integer :: n
+ character*8 :: method
+ Logical :: Yprefix, prt_cipci, print_det, restart
+ logical :: lexplicitHmat, lreadHmat, mpi_load_balance
+ Character*40 :: prefix
+ Integer (KIND=kd_int) :: iprint, idiag, iprintHmat, sizebatch
+ logical, dimension(9) :: nodet_block
+
+ namelist /sassinp/ prefix, iprint, idiag, print_det, &
+ prt_cipci, method, restart, lexplicitHmat, lreadHmat, mpi_load_balance, nodet_block, &
+ iprintHmat, sizebatch
+
+ !Initialisation
+ blan40=' '
+ method="SAS+S"
+ Yprefix =.false.
+ iprint = 0
+ idiag = 1
+ print_det = .false.
+ prt_cipci = .false.
+ prefix = blan40
+ restart = .false.
+ lexplicitHmat = .false.
+ lreadHmat = .false.
+ iprintHmat = 0
+ mpi_load_balance = .true.
+ sizebatch = 40
+ nodet_block = (/ .false., .false., .false., .false., .false., &
+ .false., .false., .false., .false. /)
+
+ read(iunit, sassinp)
+
+ if (prefix.ne.blan40) then
+ Yprefix = .true.
+ !call lowercase(prefix)
+ call noblancs(prefix,n)
+ end if
+
+ prog_info%Yprefix = Yprefix
+ prog_info%prefix = prefix(1:n)
+
+ prog_info%iprint = iprint
+ prog_info%idiag = idiag
+ prog_info%print_det = print_det
+ if (prt_cipci) then
+ call SASS_quit('Print cipci not implemented',6)
+ endif
+ prog_info%prt_cipci = prt_cipci
+
+ call lowercase(method)
+ call noblancs(method,n)
+ prog_info%method = method(1:n)
+ prog_info%methodAct = method(1:3)
+ prog_info%methodExc = method(5:n)
+
+ prog_info%restart = restart
+ prog_info%lexplicit = lexplicitHmat
+ prog_info%lreadHmat = lreadHmat
+ prog_info%iprintHmat = iprintHmat
+ prog_info%sizebatch = sizebatch
+ prog_info%mpi_load_balance = mpi_load_balance
+ prog_info%nodet_block = nodet_block
+
+#ifndef VAR_NOGEN
+ if (iprintHmat .gt. 0) then
+ call SASS_quit('Only possible to print Hmat when compiled with --nogen',6)
+ endif
+#endif
+
+end subroutine read_sassinp
+
+!!$ Local Variables:
+!!$ coding: utf-8-unix
+!!$ End:
diff --git a/src/def_files_prop.F90 b/src/def_files_prop.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5d7e31918e62878cf473371240b7db6ff82e865f
--- /dev/null
+++ b/src/def_files_prop.F90
@@ -0,0 +1,169 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+
+!> @brief Generate the file names and open them
+!> @author Marie-Bernadette Lepetit
+subroutine def_files_prop(prog_info)
+!!$ Défini les noms de fichiers
+!!$ Fait les open
+!!$ -------- Donness globales ---------------------------------
+ use files
+ use utils_char
+ use info
+!!$ -------- Donnes locales -----------------------------------
+ implicit none
+
+ type(prog_infotype), intent(inout) :: prog_info
+
+ Integer :: n
+ Character*3 :: file_det!, file_rho
+ Character*4 :: file_bdet, file_info, file_ref0
+ Character*6 :: file_input
+ Character*7 :: file_restart, file_output
+ Character*40 :: blan40
+
+ CHARACTER(LEN=8) :: date ! returned values from DATE_AND_TIME()
+ CHARACTER(LEN=10) :: time
+ CHARACTER(LEN=5) :: zone
+ INTEGER,DIMENSION(8) :: values
+
+!!$============================================================
+!!$ -------- Code ---------------------------------------------
+!!$-----
+!!$ doit definir les noms de fichiers à  associer aux unites logiques
+
+!!$-----
+!!$----- Initialisations
+!!$-----
+ blan40=' '
+ file_input = "propin"
+ file_output = "propout"
+ file_bdet = "bdet"
+ file_info = "sass"
+ file_ref0 = "ref0"
+! file_rho = "rho" ! Density matrix
+ file_restart= "restart" ! infos pour restart de la procedure de Davidson
+
+ !$-----
+!!$----- Transferts de donnes depuis Molcas ou autre
+!!$-----
+ open(f_input,file="INPUT",form="formatted")
+ call read_sassinp(f_input, prog_info)
+
+ ! Ouverture du fichier de sortie
+ if (prog_info%Yprefix) then
+ call noblancs(prog_info%prefix,n)
+ if (prog_info%id_cpu.eq.0) then
+ open (unit=f_output,file=prog_info%prefix(1:n)//"."//file_output, &
+ form="formatted")
+ endif
+ else
+ if (prog_info%id_cpu.eq.0) then
+ open (f_output,file=file_output,form="formatted")
+ end if
+ endif
+
+ if (prog_info%id_cpu.eq.0) then
+ ! Premières impressions
+ write(f_output,*) '***********************************************'
+ write(f_output,*)
+ write(f_output,*) " Programme PROPRIETES du SASS"
+ write(f_output,*)
+ write(f_output,*) '***********************************************'
+#ifdef VAR_DEBUG
+ write(f_output,'(A,L1)') ' DEBUG Version', debug
+#else
+ write(f_output,'(A)') ' RELEASE Version'
+#endif
+#ifdef VAR_MPI
+ write(f_output,'(A,I0,A)') ' MPI version - running on ',&
+ prog_info%nb_cpu,' CPUs'
+#endif
+#ifdef VAR_OMP
+ write(f_output,'(A,I0,A)') ' OMP version - running on ',&
+ prog_info%nb_thread,' threads'
+#endif
+ call date_and_time(date, time, zone, values)
+ write(f_output,*) 'Calculation started on ', date(7:8),'-',date(5:6),&
+ '-',date(1:4), ' at ', time(1:2),':',time(3:4)
+ write(f_output,*)
+
+ write(f_output,'(X,2A)') '>>> Method ',prog_info%method
+
+ write(f_output,*) ">>> Ouverture des fichiers"
+ write(f_output,9001) file_output, prog_info%prefix(1:n)//"."//file_output
+ endif
+
+ if (prog_info%Yprefix) then
+ open (f_bdet,file=prog_info%prefix(1:n)//"."//file_bdet,&
+ form="unformatted")
+ open (f_info,file=prog_info%prefix(1:n)//"."//file_info,&
+ form="unformatted")
+ !open (f_density_mat,file=prog_info%prefix(1:n)//"."//file_rho,&
+ ! form="formatted")
+ open (f_restart,file=prog_info%prefix(1:n)//"."//file_restart,&
+ form="unformatted")
+ open (f_ref0,file=prog_info%prefix(1:n)//"."//file_ref0,&
+ form="formatted")
+
+
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,9001) file_bdet, prog_info%prefix(1:n)//"."//file_bdet
+ write(f_output,9001) file_info, prog_info%prefix(1:n)//"."//file_info
+ write(f_output,9001) file_restart, prog_info%prefix(1:n)//"."//file_restart
+ !write(f_output,9001) file_rho, prog_info%prefix(1:n)//"."//file_rho
+ write(f_output,9001) file_ref0, prog_info%prefix(1:n)//"."//file_ref0
+ endif
+ else
+ open (f_bdet,file=file_bdet,form="unformatted")
+ open (f_info,file=file_info,form="unformatted")
+ open (f_restart,file=file_restart,form="unformatted")
+ !open (f_density_mat,file=file_rho,form="formatted")
+ open (f_ref0,file=file_ref0,form="formatted")
+
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,9001) file_bdet, file_bdet
+ write(f_output,9001) file_info, file_info
+ write(f_output,9001) file_restart, file_restart
+ write(f_output,9001) file_ref0, file_ref0
+ !write(f_output,9001) file_rho, file_rho
+ endif
+ end if
+
+
+
+!!$====================================================================
+9001 format(a5," :",a80)
+End subroutine def_files_prop
+
+
+!!$ Local Variables:
+!!$ coding: utf-8-unix
+!!$ End:
diff --git a/src/detact.F90 b/src/detact.F90
new file mode 100644
index 0000000000000000000000000000000000000000..147ed112e2ab2469c8f6d73758ab10c061c56891
--- /dev/null
+++ b/src/detact.F90
@@ -0,0 +1,1516 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+module detact
+
+ use info
+ use dimensions
+ use files
+ use typedet
+ use utils_wrt
+ use utils_bits
+ use vec_storage
+
+ implicit none
+
+ !$==================================================================
+ !> @brief Storage unit for the different categories of active
+ !! determinants
+ !!
+ !! The active determinants are classified based on several criteria:
+ !! * their number of CAS-CAS excitations
+ !! * their number of electrons in the active space
+ !!
+ !! For each category R^{NelCAS}_{Nexc}:
+ !! * NelCAS is the the number of additional electrons in the active
+ !! space with respect to ref0
+ !! * NexcCAS is the number of CAS-CAS excitations with respect to ref0
+ !! * NdetCAS is the number of determinants in the category
+ !! * Nb_Rlist is the total number of different categories
+ !! * elms is the (ordered) array of determinants
+ !! * connect1 is the connectivity at first order
+ !! * connect2 is the connectivity at second order
+ !!
+ !! There are 9 different categories of active det. lists:
+ !! R_0^0, R_0^1, R_0^2, R_1^0, R_1^1, R_2^0, R_-1^0, R_-1^1, R_-2^0
+ !$====================================================================
+ type, public :: detact_list
+ !> @brief NelCAS Number of additional electrons in the active space
+ integer :: NelCAS
+ !> @brief NexcCAS Number of CAS-CAS excitations
+ integer :: NexcCAS
+ !> @brief NdetCAS number of determinants in the category
+ integer :: NdetCAS
+ !> @brief Nb_rlist
+ integer :: nb_rlist
+ !> @brief Logical set to true when elms is allocated
+ logical :: alloc
+ !> @brief elms Array of active determinants in the category
+ integer(kind=kindact), pointer :: elms(:)
+!!$ !> @brief connect1
+!!$ type(intvecvec), pointer :: connect1(:)
+!!$ !> @brief connect2
+!!$ type(intvecvec), pointer :: connect2(:)
+ end type detact_list
+
+ type, public :: detact_listp
+ type(detact_list), pointer :: p
+ end type detact_listp
+
+ type, public :: rlist
+ !> @brief Storage unit for all R_M^N lists
+ type(detact_listp), dimension(:), allocatable :: l
+ integer :: nb_rlist
+ end type rlist
+
+ interface get_Rindx
+ module procedure get_Rindx2, get_Rindx1
+ end interface get_Rindx
+
+ interface get_detact
+ module procedure get_detact2, get_detact1
+ end interface get_detact
+
+contains
+
+ !$====================================================================
+ !> @brief Return the indx corresponding to a nb of electrons in the
+ !! CAS and a number of excitations
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !
+ !> @param[in] nel Nb of electrons in the CAS
+ !> @param[in] nexc Nb of excitation in the CAS
+ !> @return indx the Storage index in the R list
+ !$====================================================================
+ function get_Rindx2(nel, nexc) result(indx)
+
+ implicit none
+
+ integer, intent(in) :: nel, nexc
+ integer :: indx
+
+ select case(nel)
+ case (0)
+ select case (nexc)
+ case (0)
+ indx = 1
+ case (1)
+ indx = 2
+ case (2)
+ indx = 3
+ end select
+ case (1)
+ select case (nexc)
+ case (0)
+ indx = 4
+ case (1)
+ indx = 5
+ end select
+ case (2)
+ indx = 6
+ case (-1)
+ select case (nexc)
+ case (0)
+ indx = 7
+ case (1)
+ indx = 8
+ end select
+ case (-2)
+ indx = 9
+ end select
+ end function get_Rindx2
+
+ !$====================================================================
+ !> @brief Return the indx corresponding to a nb of electrons in the
+ !! CAS and a number of excitations '02'
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !
+ !> @param[in] name
+ !> @return indx the Storage index in the R list
+ !$====================================================================
+ function get_Rindx1(name) result(indx)
+
+ implicit none
+
+ integer, intent(in) :: name
+ integer :: indx
+
+ select case(name)
+ case (00)
+ indx = 1
+ case (01)
+ indx = 2
+ case (02)
+ indx = 3
+ case (10)
+ indx = 4
+ case (11)
+ indx = 5
+ case(20)
+ indx = 6
+ case (-10)
+ indx = 7
+ case (-11)
+ indx = 8
+ case (-20)
+ indx = 9
+ end select
+ end function get_Rindx1
+
+
+ !$====================================================================
+ !> @brief Return the pointer to the detact list corresponding to a nb
+ !! of e- in the CAS and a number of excitations
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !
+ !> @param[in] nel Nb of electrons in the CAS
+ !> @param[in] nexc Nb of excitation in the CAS
+ !> @return indx the Storage index in the R list
+ !$====================================================================
+ function get_detact2(r, nelCAS, nexcCAS) result(p)
+
+ implicit none
+
+ type(rlist), intent(in) :: r
+ integer, intent(in) :: nelCAS, nexcCAS
+ type(detact_list), pointer :: p
+
+ integer :: indx
+
+ indx = get_Rindx(nelCAS, nexcCAS)
+ p => r%l(indx)%p
+
+ end function get_detact2
+
+ !$====================================================================
+ !> @brief Return the pointer to the detact list corresponding to a nb
+ !! of e- in the CAS and a number of excitations
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !
+ !> @param[in] name -20 for R_{-2}^0
+ !> @return indx the Storage index in the R list
+ !$====================================================================
+ function get_detact1(r, name) result(p)
+
+ implicit none
+
+ type(rlist), intent(in) :: r
+ integer, intent(in) :: name
+ type(detact_list), pointer :: p
+
+ integer :: indx
+
+ indx = get_Rindx(name)
+ p => r%l(indx)%p
+
+ end function get_detact1
+
+ !$====================================================================
+ !> @brief Initialize all active part of the determinant lists R_M^N
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !
+ !> @param[inout] rlist
+ !> @param[in] nb_rlist
+ !$====================================================================
+ subroutine detact_all_init(r, nb_rlist)
+
+ implicit none
+
+ type(rlist), intent(inout) :: r
+ integer, intent(in) :: nb_rlist
+
+ if (nb_rlist .ne. 9) then
+ write(f_output,*) 'nb_rlist',nb_rlist
+ call SASS_quit('Wrong number of R_M^N lists, should be 9',f_output)
+ endif
+
+ r%nb_rlist = nb_rlist
+ allocate(r%l(r%nb_rlist))
+
+ call detact_listp_init(r, 0, 0)
+ call detact_listp_init(r, 0, 1)
+ call detact_listp_init(r, 0, 2)
+ call detact_listp_init(r, 1, 0)
+ call detact_listp_init(r, 1, 1)
+ call detact_listp_init(r, 2, 0)
+ call detact_listp_init(r, -1, 0)
+ call detact_listp_init(r, -1, 1)
+ call detact_listp_init(r, -2, 0)
+
+ end subroutine detact_all_init
+
+
+ !$====================================================================
+ !> @brief Free all active part of the determinant lists R_M^N
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !$
+ !> @param[inout] r
+ !$====================================================================
+ subroutine detact_all_free(r)
+
+ implicit none
+
+ type(rlist), intent(inout) :: r
+
+ integer :: i
+
+ do i = 1, r%nb_rlist
+ call detact_listp_free(r%l(i))
+ enddo
+
+ deallocate(r%l)
+
+ end subroutine detact_all_free
+
+
+ !$====================================================================
+ !> @brief Initialize storage for a list of active determinants
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !$
+ !> @param[inout] dcat Object to be initalized R_{NelCAS}^{NexcCAS}
+ !> @param[in] NelCAS Number of additional el in the CAS (-2 to 2)
+ !> @param[in] NexcCAS
+ !$====================================================================
+ subroutine detact_listp_init(r, NelCAS, NexcCAS)
+
+ implicit none
+
+ type(rlist), intent(inout) :: r
+ integer, intent(in) :: NelCAS, NexcCAS
+
+ integer :: indx
+
+ ! Consistency check
+ if ((NelCAS .lt. -2) .or. (NelCAS .gt. 2)) then
+ write(f_output,*) 'Incorrect number of additional active electrons', NelCAS
+ call SASS_quit('nelCAS',f_output)
+ endif
+ if ((NexcCAS .lt. 0) .or. (NexcCAS .gt. 2)) then
+ call SASS_quit('The number of CAS-CAS excitations must be 0, 1 or 2',f_output)
+ endif
+
+ ! Get storage index matching the nb of excitations and electrons
+ indx = get_Rindx(nelCAS, nexcCAS)
+ nullify(r%l(indx)%p)
+ allocate(r%l(indx)%p)
+
+ ! Initialization
+ call detact_list_init(r%l(indx)%p, NelCAS, NexcCAS, r%nb_rlist)
+
+ end subroutine detact_listp_init
+
+ !$====================================================================
+ !> @brief Free a type(detact_listp) object
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !$
+ !> @param[inout] dcat active determinant list to be freed
+ !$====================================================================
+ subroutine detact_listp_free(dcat)
+
+ implicit none
+
+ type(detact_listp), intent(inout) :: dcat
+
+ call detact_list_free(dcat%p)
+ deallocate(dcat%p)
+
+ end subroutine detact_listp_free
+
+ !$====================================================================
+ !> @brief Initialize storage for a list of active determinants
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !$
+ !> @param[inout] dcat Object to be initalized R_{NelCAS}^{NexcCAS}
+ !> @param[in] NelCAS Number of additional el in the CAS (-2 to 2)
+ !> @param[in] NexcCAS
+ !$====================================================================
+ subroutine detact_list_init(dlist, NelCAS, NexcCAS, Nb_Rlist)
+
+ implicit none
+
+ type(detact_list), intent(inout) :: dlist
+ integer, intent(in) :: NelCAS, NexcCAS, Nb_Rlist
+
+ ! Initialization
+ dlist%NelCAS = NelCAS
+ dlist%NexcCAS = NexcCAS
+ dlist%NdetCAS = 0
+ dlist%Nb_Rlist = Nb_rlist
+ dlist%alloc = .false.
+ nullify(dlist%elms)
+
+ end subroutine detact_list_init
+
+
+ !$====================================================================
+ !> @brief Free a type(detact_listp) object
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !$
+ !> @param[inout] dlist active determinant list to be freed
+ !$====================================================================
+ subroutine detact_list_free(dlist)
+
+ implicit none
+
+ type(detact_list), intent(inout) :: dlist
+
+ if (dlist%alloc) then
+ deallocate(dlist%elms)
+ endif
+
+ end subroutine detact_list_free
+
+
+ !$====================================================================
+ !> @brief Fill an active determinant list from a determinant list
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !$
+ !> @param[inout] detactlist active determinant list to be filled
+ !> @param[in] detlist total determinant list
+ !> @param[in] ndet number of total determinants in detlist
+ !$====================================================================
+ subroutine extract_detact_list(detactlist, detlist, ndet)
+
+ implicit none
+
+ type(detact_list), intent(inout) :: detactlist
+ type(deter), dimension(:), intent(in) :: detlist
+ integer, intent(in) :: ndet
+
+ integer :: idet, j
+ integer(Kind= kindact), dimension(:), allocatable :: tmpdetact
+ integer :: ndetact
+ logical :: lredundant
+
+ !> @todo remove the redundant detact
+
+ if (ndet .eq. 0) then
+ detactlist%NdetCAS = ndet
+ allocate(detactlist%elms(detactlist%NdetCAS))
+ detactlist%alloc = .true.
+ else
+ allocate(tmpdetact(ndet))
+ tmpdetact(:) = 0
+
+ ndetact = 0
+ do idet = 1, ndet
+ lredundant = .false.
+ do j=1,ndetact
+ if (tmpdetact(j) .eq. detlist(idet)%detact) lredundant = .true.
+ enddo
+ if (.not. lredundant) then
+ ndetact = ndetact+1
+ tmpdetact(ndetact) = detlist(idet)%detact
+ endif
+ enddo
+
+ detactlist%NdetCAS = ndetact
+
+ allocate(detactlist%elms(detactlist%NdetCAS))
+ detactlist%alloc = .true.
+
+ do idet = 1, ndetact
+ detactlist%elms(idet) = tmpdetact(idet)
+ enddo
+ deallocate(tmpdetact)
+ endif
+ end subroutine extract_detact_list
+
+
+ !$====================================================================
+ !> @brief Fill an active determinant list from an active determinant list
+ !> and remove the redundant ones
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !$
+ !> @param[inout] r active determinant list to be filled
+ !> @param[in] detact_array array of active part of determinants
+ !> @param[in] ndet number of active determinants
+ !$====================================================================
+ subroutine fill_detact_list(r, detact_array, ndet)
+
+ implicit none
+
+ type(detact_list), intent(inout) :: r
+ integer(Kind= kindact), dimension(:), intent(in) :: detact_array
+ integer, intent(in) :: ndet
+
+ integer :: idet, j
+ integer(Kind= kindact), dimension(:), allocatable :: tmpdetact
+ integer :: ndetact
+ logical :: lredundant
+
+ !r%NdetCAS = ndet
+
+ if (r%alloc) then
+ deallocate(r%elms)
+ endif
+
+ if (ndet.ne.0) then
+ allocate(tmpdetact(ndet))
+ tmpdetact(:) = 0
+
+ ndetact = 0
+ do idet = 1, ndet
+ lredundant = .false.
+ do j=1,ndetact
+ if (tmpdetact(j) .eq. detact_array(idet)) lredundant = .true.
+ enddo
+ if (.not. lredundant) then
+ ndetact = ndetact+1
+ tmpdetact(ndetact) = detact_array(idet)
+ endif
+ enddo
+
+ r%NdetCAS = ndetact
+
+ allocate(r%elms(r%NdetCAS))
+ r%alloc = .true.
+
+ do idet = 1, ndetact
+ r%elms(idet) = tmpdetact(idet)
+ enddo
+ deallocate(tmpdetact)
+ else
+ allocate(r%elms(1))
+ r%alloc = .true.
+ r%elms(1) = 0
+ endif
+
+
+ end subroutine fill_detact_list
+
+ !$====================================================================
+ !> @brief Remove the act. det. from dact2 contained in dact1
+ !> @author Elisa Rebolini
+ !> @date Apr 2018
+ !$
+ !> @param[inout] dact1 detact_list
+ !> @param[in] dact2 detact_list
+ !$====================================================================
+ subroutine sub_detact_list(dact1, dact2)
+
+ implicit none
+
+ type(detact_list), intent(inout) :: dact1
+ type(detact_list), intent(in) :: dact2
+
+ integer(kind=kindact), dimension(:), allocatable :: tmpelms
+ integer :: i,j,ndet
+ logical :: lredundant
+
+ ndet = 0
+ allocate(tmpelms(dact1%NdetCAS))
+ tmpelms(:) = 0
+ do i=1,dact1%NdetCAS
+ lredundant = .false.
+ !write(*,*) dact1%elms(i)
+ do j=1,dact2%NdetCAS
+ !write(*,*) dact2%elms(j)
+ if (dact1%elms(i) .eq. dact2%elms(j)) then
+ lredundant = .true.
+ endif
+ enddo
+ if (.not.lredundant) then
+ ndet = ndet + 1
+ tmpelms(ndet) = dact1%elms(i)
+ endif
+ enddo
+
+ dact1%NdetCAS = ndet
+ deallocate(dact1%elms)
+ allocate(dact1%elms(ndet))
+ dact1%elms(:) = tmpelms(1:ndet)
+ deallocate(tmpelms)
+
+ end subroutine sub_detact_list
+
+ !$===================================================================
+ !> @brief Printing subroutine for detact_list
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !$
+ !> @param[in] d detact_list to be printed
+ !> @param[in] iout Logical unit for standard output
+ !> @param[in] nact Number of active orbitals
+ !$==================================================================
+ subroutine wrt_detact_list(d, iout, nact)
+
+ implicit none
+
+ type(detact_list), intent(in) :: d
+ integer,intent(in) :: iout, nact
+
+ integer :: i
+
+ write(iout,'(A)') '==='
+ write(iout,'(A,I0,A,I0)') 'Active determinant list R_', &
+ d%nelCAS,'^',d%nexcCAS
+
+ if (debug) then
+ if (d%alloc) then
+ write(iout,'(A,I0,A)') 'Contains ',d%ndetCAS,' determinants'
+ do i = 1, d%NdetCAS
+ call wrtact(d%elms(i), iout, .false., nact)
+ enddo
+ endif
+ endif
+
+ end subroutine wrt_detact_list
+
+
+ !$===================================================================
+ !> @brief Counts the number of differences between two detacts
+ !> @author Elisa Rebolini
+ !> @date Oct 2017
+ !
+ !> @param[in] deta first detact
+ !> @param[in] detb second detact
+ !> @return ndiff integer Nb of differences
+ !$===================================================================
+ function count_diff(deta, detb, nact) result(ndiff)
+
+ implicit none
+
+ integer(kind=kindact), intent(in) :: deta, detb
+ integer, intent(in) :: nact
+
+ integer :: ndiff
+ integer(kind=kindact) :: tmp
+
+ ndiff = 0
+ tmp = (ieor(deta,detb))
+ !call wrtact(deta, f_output, .false., nact)
+ !call wrtact(detb, f_output, .false., nact)
+ !call wrtact(tmp, f_output, .false., nact)
+ ndiff = sumbits(tmp,0,2*nact-1)
+
+ end function count_diff
+
+ !$===================================================================
+ !> @brief Compute the sign of the permutation between 2 active
+ !! determinants deta and detb, returns the differences in each
+ !> @author Elisa Rebolini
+ !> @date Apr 2018
+ !
+ !> @param[in] deta first detact
+ !> @param[in] detb second detact
+ !> @param[out] diffa
+ !> @param[out] diffb
+ !> @param[out] sign_ab
+ !$===================================================================
+ subroutine sign_diff(deta, detb, diffa, diffb, and_ab, sign_ab, nact)
+
+ integer(kind=kindact), intent(in) :: deta, detb
+ integer(kind=kindact), intent(out) :: diffa, diffb, and_ab
+ integer(kind=kd_int), intent(in) :: nact
+ integer(kind=kd_int), intent(out) :: sign_ab
+
+ integer :: nactand, nperm, ibit
+
+ and_ab = iand(deta,detb)
+ diffa = iand(deta,not(and_ab))
+ diffb = iand(detb,not(and_ab))
+
+ nactand = 0
+ nperm = 0
+ do ibit=0, 2*nact-1
+ if (btest(and_ab, ibit)) nactand = nactand +1
+ if (btest(diffa, ibit)) then
+ nperm = nperm + nactand
+ endif
+ if (btest(diffb, ibit)) then
+ nperm = nperm + nactand
+ endif
+ enddo
+
+
+ if (btest(nperm,0)) then
+ sign_ab = -1
+ else
+ sign_ab = 1
+ endif
+ end subroutine sign_diff
+
+
+ !$============================================================
+ !> @brief Generate all active determinants for the screening
+ !> @author E. Rebolini
+ !> @date Apr 2018
+ !
+ !$============================================================
+ subroutine compute_all_detact(r, o_info)
+
+ type(rlist), intent(inout) :: r
+ type(o_infotype), intent(in) :: o_info
+
+ call compute_detact_CASCAS(r,0,o_info) !R01
+ call compute_R02(r, o_info) !R02
+ call compute_detact_CASCAS(r,1,o_info) !Rp11
+ call compute_detact_CASCAS(r,-1,o_info) !Rm11
+ call compute_Rp20(r, o_info) !Rp20
+ call compute_Rm20(r, o_info) !Rm20
+
+ end subroutine compute_all_detact
+
+
+ !$============================================================
+ !> @brief Generate all R02 active determinants
+ !> @author E. Rebolini
+ !> @date Apr 2018
+ !
+ !$============================================================
+ subroutine compute_R02(r, o_info)
+
+ type(rlist), intent(inout) :: r
+ type(o_infotype), intent(in) :: o_info
+
+ type(detact_list), pointer :: r00, r01, r02
+ integer(kindact), dimension(:), pointer :: newref0, NewRef1
+ integer :: nref0, NRef1cascas
+
+ integer :: n, isft, torb, nact, porb, idet, ngen, i
+ Integer (Kind= kindact), dimension(:), allocatable :: NewM
+ Integer (Kind= kindact) :: tmpact
+ Logical, parameter :: debugl=.false.
+
+ nact= o_info%nact
+ ngen=0
+
+ ! Ref0
+ r00 => get_detact(r,0,0)
+ nref0 = r00%ndetCAS
+ newref0 => r00%elms(:)
+
+ ! Ref1CASCAS
+ r01 => get_detact(r,0,1)
+ nref1cascas = r01%ndetCAS
+ newref1 => r01%elms(:)
+
+ ! Estimation of nb of det for allocation
+ n = 0
+ isft = 0
+ do torb = 0, nact-1
+ do porb = 0,nact-1
+ if (torb.eq.porb) cycle
+ do idet = 1+isft , NRef1cascas+isft
+ if (btest(NewRef1(idet), torb) .and. &
+ .not.btest(NewRef1(idet), porb)) n = n + 1
+ if (btest(NewRef1(idet), torb+nact) .and. &
+ .not.btest(NewRef1(idet), porb+nact)) n = n+1
+ if (btest(NewRef1(idet), torb) .and. &
+ .not.btest(NewRef1(idet), porb+nact)) n = n + 1
+ if (btest(NewRef1(idet), torb+nact) .and. &
+ .not.btest(NewRef1(idet), porb)) n = n+1
+ end do
+ end do
+ end do
+
+ ! Genere CAS -> CAS sur Ref1cascas
+ if (n.eq.0) then
+ ! Save the active parts in R_0^2
+ r02 => get_detact(r,0,2)
+ call fill_detact_list(r02, NewM, 0)
+ else
+
+ allocate(NewM(n))
+ NewM(:) = 0
+ do torb = 0, nact-1
+ do porb = 0,nact-1
+ if (torb.eq.porb) cycle
+ ! excitations de spin up
+ do idet = 1, nRef1CasCas
+ if (btest(NewRef1(idet), torb) .and. &
+ .not.btest(NewRef1(idet), porb)) then
+ tmpact = ibclr(NewRef1(idet), torb)
+ tmpact = ibset(tmpact,porb)
+ do i = 1,nRef0
+ if (tmpact.eq.NewRef0(i)) goto 11
+ end do
+ do i = 1,nRef1cascas
+ if (tmpact.eq.NewRef1(i)) goto 11
+ end do
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 11
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ if (debugl) then
+ call wrtact(tmpact, f_output, .true., nact)
+ write(f_output,*)
+ end if
+ end if
+11 continue
+ end do
+ ! excitations de spin down
+ do idet = 1, nRef1CasCas
+ if (btest(NewRef1(idet), torb+nact) .and. &
+ .not.btest(NewRef1(idet), porb+nact)) then
+ tmpact = ibclr(NewRef1(idet), torb+nact)
+ tmpact = ibset(tmpact,porb+nact)
+ do i = 1,nRef0
+ if (tmpact.eq.NewRef0(i)) goto 12
+ end do
+ do i = 1,nRef1cascas
+ if (tmpact.eq.NewRef1(i)) goto 12
+ end do
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 12
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ end if
+12 continue
+ end do
+ enddo
+ enddo
+ do torb = 0, nact-1
+ do porb = 0,nact-1
+ !excitation up-down
+ do idet = 1, nRef1CasCas
+ if (btest(NewRef1(idet), torb) .and. &
+ .not.btest(NewRef1(idet), porb+nact)) then
+ tmpact = ibclr(NewRef1(idet), torb)
+ tmpact = ibset(tmpact,porb+nact)
+ do i = 1,nRef0
+ if (tmpact.eq.NewRef0(i)) goto 13
+ end do
+ do i = 1,nRef1cascas
+ if (tmpact.eq.NewRef1(i)) goto 13
+ end do
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 13
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ end if
+13 continue
+ end do
+ !excitation down-up
+ do idet = 1, nRef1CasCas
+ if (btest(NewRef1(idet), torb+nact) .and. &
+ .not.btest(NewRef1(idet), porb)) then
+ tmpact = ibclr(NewRef1(idet), torb+nact)
+ tmpact = ibset(tmpact,porb)
+ do i = 1,nRef0
+ if (tmpact.eq.NewRef0(i)) goto 14
+ end do
+ do i = 1,nRef1cascas
+ if (tmpact.eq.NewRef1(i)) goto 14
+ end do
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 14
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ end if
+14 continue
+ end do
+ end do
+ end do
+
+ ! Save the active parts in R_0^2
+ r02 => get_detact(r,0,2)
+ call fill_detact_list(r02, NewM, ngen)
+ deallocate(NewM)
+ endif
+
+ end subroutine compute_R02
+
+
+ !$============================================================
+ !> @brief Generate all active determinants for R-1^1 or R_1^1
+ !! by doing a CAS-CAS excitation from R-1^0 or R_1^0 respectively
+ !> @author E. Rebolini
+ !> @date Apr 2018
+ !
+ !> @param[inout] r
+ !> @param[in] nel
+ !> @param[in] o_info
+ !$============================================================
+ subroutine compute_detact_CASCAS(r,nel,o_info)
+
+ type(rlist), intent(inout) :: r
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nel
+
+ type(detact_list), pointer :: rm10, rm11
+ integer :: nref
+ integer(kindact), dimension(:), pointer :: ref
+
+ integer :: n, torb, porb, idet, nact, ngen, i
+ Integer (Kind= kindact), dimension(:), allocatable :: NewM
+ Integer (Kind= kindact) :: tmpact
+ Logical, parameter :: debugl=.false.
+
+
+ nact= o_info%nact
+ ngen=0
+
+ ! R_{-1}^0 ou R_{1}^0
+ rm10 => get_detact(r,nel,0)
+ nref = rm10%ndetCAS
+ ref => rm10%elms(:)
+
+
+ ! CAS -> CAS sur Ref
+
+ ! Estimation of nb of det for allocation
+ n = 0
+ do torb = 0, nact-1
+ do porb = 0,nact-1
+ if (torb.eq.porb) cycle
+ do idet = 1, nref
+ if (btest(Ref(idet), torb) .and. &
+ .not.btest(Ref(idet), porb)) n = n + 1
+ if (btest(Ref(idet), torb+nact) .and. &
+ .not.btest(Ref(idet), porb+nact)) n = n+1
+ end do
+ end do
+ end do
+ do torb = 0, nact-1
+ do porb = 0,nact-1
+ do idet = 1, nref
+ if (btest(Ref(idet), torb+nact) .and. &
+ .not.btest(Ref(idet), porb)) n = n + 1
+ if (btest(Ref(idet), torb) .and. &
+ .not.btest(Ref(idet), porb+nact)) n = n+1
+ end do
+ end do
+ end do
+
+ ! Genere CAS -> CAS
+ if (n.eq.0) then
+ ! Save the active parts
+ allocate(NewM(1))
+ rm11 => get_detact(r,nel,1)
+ call fill_detact_list(rm11, NewM, 0)
+ deallocate(NewM)
+ else
+ allocate(NewM(n))
+ NewM(:) = 0
+ do torb = 0, nact-1
+ do porb = 0,nact-1
+ if (torb.eq.porb) cycle
+ ! excitations de spin up
+ do idet = 1, nRef
+ if (btest(Ref(idet), torb) .and. &
+ .not.btest(Ref(idet), porb)) then
+ tmpact = ibclr(Ref(idet), torb)
+ tmpact = ibset(tmpact,porb)
+ do i = 1,nRef
+ if (tmpact.eq.Ref(i)) goto 21
+ end do
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 21
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ if (debugl) then
+ call wrtact(tmpact, f_output, .true., nact)
+ write(f_output,*)
+ end if
+ end if
+21 continue
+ end do
+ ! excitations de spin down
+ do idet = 1, nRef
+ if (btest(Ref(idet), torb+nact) .and. &
+ .not.btest(Ref(idet), porb+nact)) then
+ tmpact = ibclr(Ref(idet), torb+nact)
+ tmpact = ibset(tmpact,porb+nact)
+ do i = 1,nRef
+ if (tmpact.eq.Ref(i)) goto 22
+ end do
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 22
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ end if
+22 continue
+ end do
+ end do
+ end do
+
+ ! In order to have distinct spin categories - separate loop
+ do torb = 0, nact-1
+ do porb = 0,nact-1
+ !if (torb.eq.porb) cycle
+ !excitation up-down
+ do idet = 1, nRef
+ if (btest(Ref(idet), torb) .and. &
+ .not.btest(Ref(idet), porb+nact)) then
+ tmpact = ibclr(Ref(idet), torb)
+ tmpact = ibset(tmpact,porb+nact)
+ do i = 1,nRef
+ if (tmpact.eq.Ref(i)) goto 23
+ end do
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 23
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ end if
+23 continue
+ end do
+ end do
+ end do
+ do torb = 0, nact-1
+ do porb = 0,nact-1
+ !excitation down-up
+ do idet = 1, nRef
+ if (btest(Ref(idet), torb+nact) .and. &
+ .not.btest(Ref(idet), porb)) then
+ tmpact = ibclr(Ref(idet), torb+nact)
+ tmpact = ibset(tmpact,porb)
+ do i = 1,nRef
+ if (tmpact.eq.Ref(i)) goto 24
+ end do
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 24
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ end if
+24 continue
+ end do
+ end do
+ end do
+
+ ! Save the active parts
+ rm11 => get_detact(r,nel,1)
+ call fill_detact_list(rm11, NewM, ngen)
+ deallocate(NewM)
+ endif
+
+ end subroutine compute_detact_CASCAS
+
+
+ !$============================================================
+ !> @brief Generate R_2^0 by adding an electron in R_1^0
+ !> @author E. Rebolini
+ !> @date Apr 2018
+ !
+ !> @param[inout] r
+ !> @param[in] o_info
+ !$============================================================
+ subroutine compute_Rp20(r, o_info)
+
+ type(rlist), intent(inout) :: r
+ type(o_infotype), intent(in) :: o_info
+
+ type(detact_list), pointer :: rp10, rp20
+ integer :: nref
+ integer(kindact), dimension(:), pointer :: ref
+
+ integer :: n, porb, idet, nact, ngen, i
+ Integer (Kind= kindact), dimension(:), allocatable :: NewM
+ Integer (Kind= kindact) :: tmpact
+ Logical, parameter :: debugl=.false.
+
+ nact= o_info%nact
+ ngen=0
+
+ ! R_{1}^0
+ rp10 => get_detact(r,1,0)
+ nref = rp10%ndetCAS
+ ref => rp10%elms(:)
+
+ ! Estimation of nb of det for allocation
+ n = 0
+ do porb = 0,nact-1
+ do idet = 1, nref
+ if (.not.btest(Ref(idet), porb)) n = n + 1
+ if (.not.btest(Ref(idet), porb+nact)) n = n+1
+ end do
+ end do
+
+ if (n.eq.0) then
+ ! Save the active parts
+ rp20 => get_detact(r,2,0)
+ call fill_detact_list(rp20, NewM, 0)
+ else
+ allocate(NewM(n))
+ NewM(:) = 0
+ do porb = 0,nact-1
+ ! excitations de spin up
+ do idet = 1, nRef
+ if (.not.btest(Ref(idet), porb)) then
+ tmpact = ibset(Ref(idet),porb)
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 31
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ if (debugl) then
+ call wrtact(tmpact, f_output, .true., nact)
+ write(f_output,*)
+ end if
+ end if
+31 continue
+ end do
+ ! excitations de spin down
+ do idet = 1, nRef
+ if (.not.btest(Ref(idet), porb+nact)) then
+ tmpact = ibset(ref(idet),porb+nact)
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 32
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ end if
+32 continue
+ end do
+ end do
+
+ ! Save the active parts
+ rp20 => get_detact(r,2,0)
+ call fill_detact_list(rp20, NewM, ngen)
+ deallocate(NewM)
+ endif
+
+ end subroutine compute_Rp20
+
+ !$============================================================
+ !> @brief Generate R_-2^0 by removing an electron from R_-1^0
+ !> @author E. Rebolini
+ !> @date Apr 2018
+ !
+ !> @param[inout] r
+ !> @param[in] o_info
+ !$============================================================
+ subroutine compute_Rm20(r, o_info)
+
+ type(rlist), intent(inout) :: r
+ type(o_infotype), intent(in) :: o_info
+
+ type(detact_list), pointer :: rm10, rm20
+ integer :: nref
+ integer(kindact), dimension(:), pointer :: ref
+
+ integer :: n, torb, idet, nact, ngen, i
+ Integer (Kind= kindact), dimension(:), allocatable :: NewM
+ Integer (Kind= kindact) :: tmpact
+ Logical, parameter :: debugl=.false.
+
+ nact= o_info%nact
+ ngen=0
+
+ ! R_{-1}^0
+ rm10 => get_detact(r,-1,0)
+ nref = rm10%ndetCAS
+ ref => rm10%elms(:)
+
+ ! Estimation of nb of det for allocation
+ n = 0
+ do torb = 0,nact-1
+ do idet = 1, nref
+ if (btest(Ref(idet), torb)) n = n + 1
+ if (btest(Ref(idet), torb+nact)) n = n+1
+ end do
+ end do
+
+ if (n.eq.0) then
+ ! Save the active parts
+ rm20 => get_detact(r,-2,0)
+ call fill_detact_list(rm20, NewM, 0)
+ else
+ allocate(NewM(n))
+ NewM(:) = 0
+ do torb = 0,nact-1
+ ! excitations de spin up
+ do idet = 1, nRef
+ if (btest(Ref(idet), torb)) then
+ tmpact = ibclr(Ref(idet),torb)
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 41
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ if (debugl) then
+ call wrtact(tmpact, f_output, .true., nact)
+ write(f_output,*)
+ end if
+ end if
+41 continue
+ end do
+ ! excitations de spin down
+ do idet = 1, nRef
+ if (btest(Ref(idet), torb+nact)) then
+ tmpact = ibclr(ref(idet),torb+nact)
+ do i = 1,ngen
+ if (tmpact.eq.NewM(i)) goto 42
+ end do
+ ngen = ngen + 1
+ NewM(ngen) = tmpact
+ end if
+42 continue
+ end do
+ end do
+
+ ! Save the active parts
+ rm20 => get_detact(r,-2,0)
+ call fill_detact_list(rm20, NewM, ngen)
+ deallocate(NewM)
+ endif
+
+ end subroutine compute_Rm20
+
+
+
+ !$===================================================================
+ !> @brief List the spatial orbitals and their spins in a given active
+ !! determinant
+ !> @author Elisa Rebolini
+ !> @date Apr 2018
+ !$
+ !> @param[in] d active determinant
+ !> @param[in] nact Nb of active orbitals
+ !> @param[in] no Nb of occupied (and frozen) orbitals
+ !> @param[out] a List of spatial orbitals numbers
+ !> @param[out] s List of spins
+ !$==================================================================
+ subroutine extract_orbindx_from_detact(d, a, s, no, nact, ndiff)
+ !subroutine extract_orbindx_from_detact(d, a, s, no, nact, nelact, ndiff)
+ integer(kindact), intent(in) :: d
+ integer, intent(in) :: nact, no
+ integer, dimension(:) :: a
+ integer, dimension(:) :: s
+ integer, intent(out), optional :: ndiff
+
+ integer :: ibit, i
+
+ a(:) = 0
+ s(:) = 0
+ i = 1
+
+ do ibit=0,nact-1
+ if (btest(d,ibit)) then
+ a(i)=no+ibit+1
+ s(i) = 1
+ !write (*,'(I0,A,X)', advance="no") a(i), 'u'
+ i = i+1
+ endif
+ enddo
+ do ibit=nact,2*nact-1
+ if (btest(d,ibit)) then
+ a(i)=no+ibit+1-nact
+ s(i) = -1
+ !write (*,'(I0,A,X)', advance="no") a(i), 'd'
+ i = i+1
+ endif
+ enddo
+
+ if (present(ndiff)) ndiff = i-1
+ !write(*,*)
+
+ end subroutine extract_orbindx_from_detact
+
+ !$===================================================================
+ !> @brief Return the spin of a detact
+ !> @author Elisa Rebolini
+ !> @date May 2018
+ !
+ !> @param[in] d detact
+ !> @param[in] nact Number of active orbitals
+ !> @return spin_detact Spin of the active determinant
+ !$===================================================================
+ integer function spin_detact(d,nact)
+
+ integer(kindact), intent(in) :: d
+ integer, intent(in) :: nact
+
+ spin_detact = sumbits(d,0,nact-1) - sumbits(d,nact, 2*nact-1)
+
+ end function spin_detact
+
+
+ !$===================================================================
+ !> @brief Return the spin difference between a detact and sz
+ !> @author Elisa Rebolini
+ !> @date May 2018
+ !
+ !> @param[in] d detact
+ !> @param[in] nact Number of active orbitals
+ !> @param[in] sz Spin of the ref0 configurations
+ !> @return spindiff_detact Spin difference between the detact and sz
+ !$===================================================================
+ integer function spindiff_detact(d,nact,sz)
+
+ integer(kindact), intent(in) :: d
+ integer, intent(in) :: nact, sz
+
+ spindiff_detact = sumbits(d,0,nact-1) - sumbits(d,nact, 2*nact-1) - sz
+
+ end function spindiff_detact
+
+
+!!$ !$====================================================================
+!!$ !> @brief Compute the connectivity for all R list pairs R_M^N
+!!$ !> @author Elisa Rebolini
+!!$ !> @date Oct 2017
+!!$ !$
+!!$ !> @param[inout] r
+!!$ !$====================================================================
+!!$ subroutine detact_all_connect(r, o_info)
+!!$
+!!$ type(o_infotype), intent(in) :: o_info
+!!$ type(rlist), intent(inout) :: r
+!!$
+!!$ integer :: i,j, idet
+!!$ type(detact_list), pointer :: ri, rj
+!!$
+!!$ do i = 1, r%nb_rlist
+!!$ do j = 1, r%nb_rlist
+!!$ ri => r%l(i)%p
+!!$ rj => r%l(j)%p
+!!$
+!!$ call compute_connectivity(ri, rj, j, o_info)
+!!$
+!!$ enddo
+!!$ enddo
+!!$
+!!$ end subroutine detact_all_connect
+
+!!$ !$===================================================================
+!!$ !> @brief Compute the connectivity at 1st and second order between
+!!$ !! two lists of active determinants
+!!$ !! Stores the positions of the active determinants detb of dlb which
+!!$ !! connect with a given determinant deta of dla
+!!$ !! with Ndiff the number of different creation operators in the det
+!!$ !! and deltaNel the difference in number of active electrons,
+!!$ !! connect1 connects determinants where ndiff + deltaNel = 2
+!!$ !! connect2 connects determinants where ndiff + deltaNel = 4
+!!$ !! N.B. use the subroutine CM1() and CM2() to access these matrices
+!!$ !
+!!$ !> @author Elisa Rebolini
+!!$ !> @date Oct 2017
+!!$ !$
+!!$ !> @param[inout] dla first detact_list
+!!$ !> @param[inout] dlb second detact_list
+!!$ !> @param[in] idlb position of the detact_list dlb in the global list
+!!$ !$===================================================================
+!!$ subroutine compute_connectivity(dla, dlb, idlb, o_info)
+!!$
+!!$ implicit none
+!!$
+!!$ type(detact_list), intent(inout) :: dla, dlb
+!!$ integer, intent(in) :: idlb
+!!$ type(o_infotype), intent(in) :: o_info
+!!$
+!!$ integer :: ideta, idetb
+!!$ integer :: deltaNel
+!!$ integer(kindact), pointer :: tmp1(:), tmp2(:)
+!!$ integer :: iter1, iter2, ndiff, i
+!!$ integer :: nact
+!!$
+!!$ nact = o_info%nact
+!!$
+!!$ !Case ndetCAS = 0 >> dealt with in CM1 and CM2 functions
+!!$
+!!$ if (.not.((dla%ndetCAS .eq. 0) .or. (dlb%ndetCAS .eq. 0))) then
+!!$ deltaNel = abs(dla%NelCAS - dlb%NelCAS)
+!!$ if (deltaNel .gt. 2) then
+!!$ !No connectivity matrices are computed
+!!$ call vec_init(dla%connect1(idlb), 0)
+!!$ call vec_init(dla%connect2(idlb), 0)
+!!$ else
+!!$ !Connectivity at 1st and 2nd order are computed
+!!$ !initialise the dla%connect1 and dla%connect2 at the position
+!!$ !corresponding to dlb
+!!$ !they will contain dla%ndetCAS vectors (i.e. one vector for each
+!!$ !active det in dla) with the list of connecting vector in dlb
+!!$ call vec_init(dla%connect1(idlb), dla%ndetCAS)
+!!$ call vec_init(dla%connect2(idlb), dla%ndetCAS)
+!!$
+!!$ allocate(tmp1(dlb%ndetcas))
+!!$ allocate(tmp2(dlb%ndetcas))
+!!$ do ideta = 1, dla%ndetcas
+!!$ tmp1(:) = 0
+!!$ tmp2(:) = 0
+!!$ iter1 = 0
+!!$ iter2 = 0
+!!$
+!!$ do idetb = 1, dlb%ndetcas
+!!$ ndiff = count_diff(dla%elms(ideta),dlb%elms(idetb), o_info%nact)
+!!$ !write(f_output,*) ndiff, deltaNel, ndiff + deltaNel
+!!$ if ((ndiff + deltaNel) .eq. 2) then
+!!$ iter1 = iter1 + 1
+!!$ tmp1(iter1) = idetb
+!!$ !write(f_output,*) 'Add to CM1'
+!!$ !call wrtact(dlb%elms(idetb), f_output, .false., nact)
+!!$ else if ((ndiff + deltaNel) .eq. 4) then
+!!$ iter2 = iter2 + 1
+!!$ tmp2(iter2) = idetb
+!!$ !write(f_output,*) 'Add to CM2'
+!!$ !call wrtact(idetb, f_output, .false., nact)
+!!$ !call wrtact(tmp2(iter2), f_output, .false., nact)
+!!$ endif
+!!$ enddo
+!!$ call vec_init(dla%connect1(idlb), ideta, iter1)
+!!$ if (iter1 .ne. 0) then
+!!$ dla%connect1(idlb)%vl(ideta)%p%elms = tmp1(1:iter1)
+!!$ endif
+!!$
+!!$ call vec_init(dla%connect2(idlb), ideta, iter2)
+!!$ if (iter2 .ne. 0) then
+!!$ dla%connect2(idlb)%vl(ideta)%p%elms = tmp2(1:iter2)
+!!$ endif
+!!$ enddo
+!!$ deallocate(tmp1)
+!!$ deallocate(tmp2)
+!!$ endif
+!!$ endif
+!!$
+!!$ end subroutine compute_connectivity
+
+
+!!$ !===================================================================
+!!$ !> @brief Write the connectivity matrix Ri%CM1(idet,Rj)
+!!$ !! returns the number of connected active determinants and their
+!!$ !! positions in Rj%elms(:)
+!!$ !> @author Elisa Rebolini
+!!$ !> @date Apr 2018
+!!$ !
+!!$ !> @param[in] ri
+!!$ !> @param[in] rj
+!!$ !> @param[in] idet
+!!$ !> @param[in] o_info
+!!$ !> @param[out] nCM1
+!!$ !> @param[out] detCM1
+!!$ !===================================================================
+!!$ subroutine CM1_detact_list(ri, rj, idet, nact, nCM1, detCM1)
+!!$ type(detact_list), intent(in) :: ri, rj
+!!$ integer, intent(in) :: idet
+!!$ integer, intent(in) :: nact
+!!$ integer :: nCM1
+!!$ integer, pointer :: detCM1(:)
+!!$
+!!$ integer :: indx_rj, i, deltaNel
+!!$ logical :: debug = .false.
+!!$
+!!$ deltaNel = abs(ri%NelCAS - rj%NelCAS)
+!!$ indx_rj = get_Rindx(rj%nelCAS, rj%nexcCAS)
+!!$ if ((rj%ndetCAS .eq. 0) .or. (deltaNel .gt. 2)) then
+!!$ nCM1 = 0
+!!$ else
+!!$ nCM1 = ri%connect1(indx_rj)%vl(idet)%p%nrow
+!!$ endif
+!!$
+!!$ if (debug) then
+!!$ write(f_output,'(A,I0,I0,A)',advance="no") 'R',ri%nelCAS, ri%nexcCAS,'%CM1('
+!!$ call wrtact(ri%elms(idet), f_output, .true., nact)
+!!$ write(f_output,'(A,I0,I0,A)',advance="no") ', R',rj%nelCAS, rj%nexcCAS,') '
+!!$ write(f_output,'(A,X,I0,X,A)') 'contains', nCM1, 'active determinants'
+!!$ endif
+!!$
+!!$ if (nCM1 .ne. 0) then
+!!$ detCM1 => ri%connect1(indx_rj)%vl(idet)%p%elms(:)
+!!$ if (debug) then
+!!$ do i = 1, nCM1
+!!$ call wrtact(rj%elms(detCM1(i)), f_output, .true., nact)
+!!$ write(f_output,'(4X)',advance="no")
+!!$ enddo
+!!$ write(f_output,*)
+!!$ endif
+!!$ endif
+!!$ end subroutine CM1_detact_list
+!!$
+!!$ !===================================================================
+!!$ !> @brief Write the connectivity matrix Ri%CM2(idet,Rj)
+!!$ !! returns the number of connected active determinants and their
+!!$ !! positions in Rj%elms(:)
+!!$ !> @author Elisa Rebolini
+!!$ !> @date Apr 2018
+!!$ !
+!!$ !> @param[in] ri
+!!$ !> @param[in] rj
+!!$ !> @param[in] idet
+!!$ !> @param[in] o_info
+!!$ !> @param[out] nCM2
+!!$ !> @param[out] detCM2
+!!$ !===================================================================
+!!$ subroutine CM2_detact_list(ri, rj, idet, nact, nCM2, detCM2)
+!!$ type(detact_list), intent(in) :: ri, rj
+!!$ integer, intent(in) :: idet
+!!$ integer, intent(in) :: nact
+!!$ integer :: nCM2
+!!$ integer, pointer :: detCM2(:)
+!!$
+!!$ integer :: indx_rj,i, deltaNel
+!!$ logical :: debug = .false.
+!!$
+!!$ deltaNel = abs(ri%NelCAS - rj%NelCAS)
+!!$
+!!$ indx_rj = get_Rindx(rj%nelCAS, rj%nexcCAS)
+!!$ if ((rj%ndetCAS .eq. 0) .or. (deltaNel .gt. 2))then
+!!$ nCM2 = 0
+!!$ else
+!!$ nCM2 = ri%connect2(indx_rj)%vl(idet)%p%nrow
+!!$ endif
+!!$
+!!$ if (debug) then
+!!$ write(f_output,'(A,I0,I0,A)',advance="no") 'R',ri%nelCAS, ri%nexcCAS,'%CM2('
+!!$ call wrtact(ri%elms(idet), f_output, .true., nact)
+!!$ write(f_output,'(A,I0,I0,A)',advance="no") ', R',rj%nelCAS, rj%nexcCAS,') '
+!!$ write(f_output,'(A,X,I0,X,A)') 'contains', nCM2, 'active determinants'
+!!$ endif
+!!$
+!!$ if (nCM2 .ne. 0) then
+!!$ detCM2 => ri%connect2(indx_rj)%vl(idet)%p%elms(:)
+!!$ if (debug) then
+!!$ do i = 1, nCM2
+!!$ call wrtact(rj%elms(detCM2(i)), f_output, .true., nact)
+!!$ write(f_output,'(4X)',advance="no")
+!!$ enddo
+!!$ write(f_output,*)
+!!$ endif
+!!$ endif
+!!$
+!!$ end subroutine CM2_detact_list
+
+
+end module detact
+!!$ Local Variables:
+!!$ coding: utf-8-unix
+!!$ End:
+
+
diff --git a/src/diag.F90 b/src/diag.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9a20c4ecf929635de419a8bf0e771412721aaab2
--- /dev/null
+++ b/src/diag.F90
@@ -0,0 +1,151 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+
+!$====================================================================
+!> @brief full diagonalisation routine
+!! can use Lapack dsyevd or given or jacscf
+!
+!> @param[in] H(ndet,ndet) = matrix to diagonalize
+!> @param[out] E(ndet) = eigenvalues
+!> @param[out] V(ndet,ndet) = eigenvectors
+!> @param[in] ndet = matrix dimension
+!> @param[in] idiag = diagonalisation method
+!! idiag = 1 : Lapack dsyevd
+!! idiag = 2 : given
+!! idiag = 3 : jacscf
+!! idiag =-1 : zheev
+!> @param[in] iout : output file
+!> @param[out] info : diagonalisation error code
+!$====================================================================
+
+subroutine diag(H,E,V,ndet,idiag,iout,info)
+
+ use dimensions
+
+ implicit none
+
+
+ Integer, intent(in) :: ndet, idiag, iout
+ Integer, intent(out) :: info
+ real(kd_dble), dimension(ndet,ndet), intent(in) :: H
+ real(kd_dble), dimension(ndet,ndet), intent(out) :: V
+ real(kd_dble), dimension(ndet), intent(out) :: E ! , vtmp
+
+ !Integer, parameter :: pas=10
+ !real(kd_dble), dimension(:), allocatable :: hgiven
+ complex*16, dimension(:,:), allocatable :: hcgiven
+ complex*16, dimension(:), allocatable :: work
+ real(kd_dble), dimension(:), allocatable :: rwork
+ !real(kd_dble) :: tmp
+ Integer :: i,j,k,n
+
+ integer :: liwork, lwork
+ integer, dimension(:), allocatable :: iwork
+
+
+ if (idiag.eq.3) then
+ call jacobi_jacscf(e,V,H,ndet,ndet,.true.)
+!!$ else if (idiag.eq.2) then !!! given
+!!$ allocate (hgiven((ndet*(ndet+1))/2))
+!!$ hgiven(:) = 0.d0
+!!$ e(:) = 0.d0
+!!$ V(1:ndet,1:ndet) = 0.d0
+!!$ k = 0
+!!$ do i=1,ndet
+!!$ do j=i,ndet
+!!$ k=k+1
+!!$ hgiven(k) = h(i,j)
+!!$ end do
+!!$ end do
+!!$ call given(hgiven,E,V,ndet,ndet,ndet)
+!!$ deallocate(hgiven)
+
+ else if ((idiag.eq.1).or.(idiag.eq.2)) then !!! dsyevd
+ V(:,:) = 0.d0
+ e(:) = 0.d0
+ do j = 1,ndet
+ do i = 1,ndet
+ V(i,j) = H(i,j)
+ end do
+ end do
+
+ !For degenerate eigenvalues, dsyev returns non-orthogonal eigenvectors
+ !had to switch to dsyevd
+ lwork = 1 + 6*ndet + 2*ndet**2
+ liwork = 3 + 5*ndet
+ allocate(rwork(lwork))
+ allocate(iwork(liwork))
+ rwork(:) = 0.d0
+
+ call dsyevd ('V', 'U', Ndet, V, ndet, E, rwork, lwork, iwork, liwork, info)
+ deallocate(rwork)
+ deallocate(iwork)
+
+ if (info.ne.0) then
+ write(iout,*)
+ write(iout,*) " Info =", info
+ call SASS_quit("***** Erreur diag. mat. sym. dsyevd *****",iout)
+ write(iout,*)
+ flush(iout)
+ end if
+
+ else if (idiag.eq.-1) then
+
+ k = max(1, 3*Ndet-2)
+ allocate (hcgiven(ndet,ndet), work(3*ndet), rwork(k))
+ v(:,:) = 0.d0
+ hcgiven(1:ndet,1:ndet) = (0.d0,0d0)
+ do j=1,ndet
+ do i=j,ndet
+ hcgiven(i,j) = cmplx ( 0.d0, h(i,j), kind = 8 )
+ end do
+ end do
+ work (:) = (0.d0, 0.d0)
+ rwork (:) = 0.d0
+ call zheev ('V', 'L', Ndet, hcgiven, ndet, E, WORK, 3*ndet, RWORK, info)
+ deallocate (work,rwork)
+ deallocate(hcgiven)
+ if (info.eq.0) then
+ return
+ else
+ write(iout,*)
+ write(iout,*) " Info =", info
+ flush(iout)
+ call SASS_quit("***** Erreur diag. mat. antisym. *****",iout)
+ end if
+
+ else
+ write(iout,*) " idiag =", idiag
+ flush(iout)
+ call SASS_quit(" ***** Erreur idiag *****",iout)
+ end if
+
+ end subroutine diag
+
diff --git a/src/dimensions.F90 b/src/dimensions.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e6be5cfdefc4d37bd0066c46ed7b670eeaf3a4b8
--- /dev/null
+++ b/src/dimensions.F90
@@ -0,0 +1,210 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+!> @brief Definition des parametres
+module dimensions
+
+#ifdef VAR_OMP
+ !$ use OMP_LIB
+#endif
+
+#ifdef VAR_MPI
+#ifdef VAR_GNU
+ use mpi
+#elif VAR_INTEL
+ include "mpif.h"
+#endif
+#endif
+
+ !> @brief Nb of bits for a real
+ integer, parameter :: realk = selected_real_kind(15, 307)
+ !> @brief kd_int : nbre d'octets pour un entier standart
+ Integer, parameter :: kd_int = 4
+ !> @brief kd_dble : nbre d'octets pour un double standart
+ integer, parameter :: kd_dble = 8
+ !> @brief NACT_MAX : nbre max d'orbitales actives
+ Integer (KIND=kd_int), parameter :: NACT_MAX = 32
+ !> @brief kindact : nbre d'octets sur lesquels sont codés les actives
+ integer (kind=kd_int), parameter :: kindact = 8
+ !> @brief kindTP : nbre d'octets pour un trou/part avec son spin
+ Integer (KIND=kd_int), parameter :: kindTP = 2
+ !> @brief IRREP_MAX : nbre maximum d'irrep
+ Integer (KIND=kd_int), parameter :: IRREP_MAX = 8
+ !> @brief NREF0_MAX : nbre maximum de ref0
+ Integer (KIND=kd_int), parameter :: NREF0_MAX = 10
+ !> @brief NPROP_MAX : nbre maximum de proprietes
+ Integer (KIND=kd_int), parameter :: nprop_max = 10
+ !> @brief MxOrb : nbre maximum d'orbitales dans Molcas
+ Integer (KIND=kd_int), public :: MxOrb=10000
+ !> @brief DEBUG : Impressions de debuggage
+#ifdef VAR_DEBUG
+ Logical, parameter :: DEBUG=.true.
+#else
+ Logical, parameter :: DEBUG=.false.
+#endif
+#ifdef VAR_NOGEN
+ !> @brief Do not use generated code
+ Logical, parameter :: lgen=.false.
+#else
+ !> @brief Use Generated code
+ Logical, parameter :: lgen=.true.
+#endif
+ !> @brief Number of hole-particle cases
+ integer, parameter :: num_cases = 31
+
+contains
+
+ !$====================================================================
+ !> @brief Quit with error message msg
+ !> @author Elisa Rebolini
+ !> @date Nov 2017
+ !$====================================================================
+ subroutine SASS_quit(msg, iout)
+
+ implicit none
+
+ character(len=*), intent(in) :: msg
+ integer, intent(in) :: iout
+
+ write(iout,'(A)') msg
+ flush(iout)
+ stop 1
+
+ end subroutine SASS_quit
+
+ !> \brief Return elapsed CPU time and elapsed real time.
+ !> \author H. J. Aa. Jensen. Modified by S. Host
+ !> \date December 18, 1984
+ subroutine gettime(cputime,walltime)
+
+ implicit none
+ real(kd_dble), intent(out) :: cputime, walltime
+
+ real(kd_dble),PARAMETER :: D0 = 0.0E0_kd_dble
+ logical :: first = .true.
+ real(kd_dble), save :: TCPU0, twall0
+ real(kd_dble) :: tcpu1, twall1
+ integer :: dateandtime0(8), dateandtime1(8)
+ dateandtime0 = 0
+ dateandtime1 = 0
+
+ if (first) then
+ first = .false.
+ call cpu_time(TCPU0)
+ call date_and_time(values=dateandtime0)
+ call get_walltime(dateandtime0,twall0)
+ end if
+ call cpu_time(tcpu1)
+ call date_and_time(values=dateandtime1)
+ call get_walltime(dateandtime1,twall1)
+
+ cputime = tcpu1 - TCPU0
+ walltime = twall1 - twall0
+
+ end subroutine gettime
+
+ !> \brief Get elapsed walltime in seconds since 1/1-2010 00:00:00
+ !> \author S. Host
+ !> \date October 2010
+ !>
+ !> Years that are evenly divisible by 4 are leap years.
+ !> Exception: Years that are evenly divisible by 100 are not leap years,
+ !> unless they are also evenly divisible by 400. Source: Wikipedia
+ !>
+ subroutine get_walltime(dateandtime,walltime)
+
+ implicit none
+ !> "values" output from fortran intrinsic subroutine date_and_time
+ integer, intent(in) :: dateandtime(8)
+ !> Elapsed wall time in seconds
+ real(kd_dble), intent(out) :: walltime
+ integer :: month, year
+
+ ! The output from the fortran intrinsic date_and_time
+ ! gives the following values:
+ ! 1. Year
+ ! 2. Month
+ ! 3. Day of the month
+ ! 4. Time difference in minutes from Greenwich Mean Time (GMT)
+ ! 5. Hour
+ ! 6. Minute
+ ! 7. Second
+ ! 8. Millisecond
+
+ ! Count seconds, minutes, hours, days, months and years and sum up seconds:
+ ! We don't count milliseconds.
+
+ walltime = 0.0E0_kd_dble
+
+ walltime = dble(dateandtime(8))/1.0E3_kd_dble !Seconds counted
+
+ walltime = walltime + dble(dateandtime(7)) !Seconds counted
+
+ walltime = walltime + 60E0_kd_dble*dateandtime(6) !Minutes counted
+
+ walltime = walltime + 3600E0_kd_dble*dateandtime(5) !Hours counted
+
+ walltime = walltime + 24E0_kd_dble*3600E0_kd_dble*(dateandtime(3)-1) !Days counted (substract 1 to count only whole days)
+
+ !Months are special, since they are not equally long:
+
+ do month = 1, dateandtime(2)-1 !substract 1 to count only whole months
+ if (month == 1 .or. month == 3 .or. month == 5 .or. month == 7 .or. &
+ & month == 8 .or. month == 10) then !Since we subtract 1, month can never be 12
+ walltime = walltime + 31E0_kd_dble*24E0_kd_dble*3600E0_kd_dble
+ else if (month == 2) then
+ if (.false.) then !insert exception for if current year is a leap year
+ walltime = walltime + 29E0_kd_dble*24E0_kd_dble*3600E0_kd_dble
+ else
+ walltime = walltime + 28E0_kd_dble*24E0_kd_dble*3600E0_kd_dble
+ endif
+ else if (month == 4 .or. month == 6 .or. month == 9 .or. month == 11) then
+ walltime = walltime + 30E0_kd_dble*24E0_kd_dble*3600E0_kd_dble
+ else
+ stop 'Unknown month (get_walltime)'
+ endif
+ enddo
+
+ !Years are special, since leap years are one day longer:
+
+ do year = 2010, dateandtime(1)
+ if (mod(year,400)==0) then
+ walltime = walltime + 366*24*3600 !Leap year
+ else if (mod(year,100)==0) then
+ walltime = walltime + 365*24*3600 !Not leap year
+ else if (mod(year,4)==0) then
+ walltime = walltime + 366*24*3600 !Leap year
+ else
+ walltime = walltime + 365*24*3600 !Not leap year
+ endif
+ enddo
+
+ end subroutine get_walltime
+
+End module dimensions
diff --git a/src/explicit_Hmat.F90 b/src/explicit_Hmat.F90
new file mode 100644
index 0000000000000000000000000000000000000000..94c6ab8164ffa1ef73806e9b74e2ac280ef780e9
--- /dev/null
+++ b/src/explicit_Hmat.F90
@@ -0,0 +1,998 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+
+module explicit_Hmat
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use typebraket
+
+ implicit none
+
+contains
+
+
+ !$====================================================================
+ !> @brief Compute explicitely <Idet|H|Jdet>
+ !> @author ER and RB
+ !> @date June 2019
+ !
+ !> @param idet Index of determinant I
+ !> @param jdet Index of determinant J
+ !> @param det List of all determinants
+ !> @param fock Fock matrix
+ !> @param hdiag Diagonal of the Hamiltonian matrix
+ !> @param g_info General info
+ !> @param prog_info Program Info
+ !> @param o_info Orbital info
+ !> @param int_info Integral info
+ !> @param v_info Info on the vectors
+ !> @param ener_info Energy info
+ !> @param iout Output unit
+ !> @return explicit_Hij Value of the matrix element <Idet|H|Jdet>
+ !
+ !> there is two output files (usually fort.60 and fort.61) the first
+ !> one is a telling us the number of excitations between det I and J,
+ !> but also which integrals were needed in this case and their signs.
+ !> fort.61 is filled with minimal informations (: idet, jdet, result)
+ !> in order to be compared with the results of the generated program
+ !> in debug mode. To use this programme, lexplicit=.true. should be
+ !> in the INPUT file.
+ !$====================================================================
+ function explicit_Hij(idet, jdet, det, fock, hdiag, g_info, prog_info, &
+ o_info, int_info, v_info, ener_info, iout)
+
+ real(kd_dble) :: explicit_Hij
+ integer, intent(in) :: idet, jdet
+ type(deter), dimension(:), allocatable :: det
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(g_infotype), intent(in) :: g_info
+ type(prog_infotype), intent(in) :: prog_info
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(v_infotype), intent(in) :: v_info
+ type(ener_infotype), intent(inout) :: ener_info
+ integer, intent(in) :: iout
+
+
+ !Local variables
+ type(deter) :: detI, detJ
+ type(braket) :: Hij
+ integer (Kind= kindact) :: diffI, diffJ, and_IJ
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, nelact
+ integer :: signact, sign, signt, signp
+ integer, dimension(:), allocatable :: ai, aj, si, sj, a, s
+ integer :: ndiffI, ndiffJ, nandIJ, nhI, nhJ, ndiffh, Ndiffp, Ndifftot
+ integer :: i
+ real(kd_dble) :: elm
+
+
+ !Initialisation
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ nelact = g_info%nelact
+ Ndiffh = 0
+ Ndiffp = 0
+
+ explicit_Hij = 0.0d0
+ elm = 0.0d0
+
+ allocate(a(2*nact), ai(2*nact), aj(2*nact))
+ allocate(s(2*nact), si(2*nact), sj(2*nact))
+
+ detI = det(idet)
+ detJ = det(jdet)
+
+ write(iout, *) ' '
+ write(iout, *) '------------------------------------'
+ write(iout, '(A,I4,A,I4,A)',advance='yes') &
+ 'Explicit matrix element for <',idet,'|H|',jdet,'>'
+ write(iout, *) ' '
+
+ call wrtdet(detI, iout, o_info)
+ call wrtdet(detJ, iout, o_info)
+
+ sign = 1
+ signt = 1
+ signp = 1
+ nhI = 0
+ nhJ = 0
+
+ !Fill Hij from detI and detJ
+ call braket_init(Hij)
+
+ !Hole t1
+ Hij%sot1 = detI%dettr(1)
+ if (Hij%sot1 .ne. 0) then
+ if (Hij%sot1 .le. 2*ngel + nocc + nligo) then
+ Hij%t1 = Hij%sot1 - ngel
+ Hij%spint1 = 1
+ else
+ Hij%t1 = Hij%sot1 - ngel - nocc - nligo
+ Hij%spint1 = -1
+ endif
+ signt = (-1)**(Hij%sot1 -1)
+ nhI = 1
+ endif
+
+ !Hole t2
+ Hij%sot2 = detI%dettr(2)
+ if (Hij%sot2 .ne. 0) then
+ if (Hij%sot2 .le. 2*ngel + nocc + nligo) then
+ Hij%t2 = Hij%sot2 - ngel
+ Hij%spint2 = 1
+ else
+ Hij%t2 = Hij%sot2 - ngel - nocc - nligo
+ Hij%spint2 = -1
+ endif
+ nhI = 2
+ endif
+
+ !Hole t3
+ Hij%sot3 = detJ%dettr(1)
+ if (Hij%sot3 .ne. 0) then
+ if (Hij%sot3 .le. 2*ngel + nocc + nligo) then
+ Hij%t3 = Hij%sot3 - ngel
+ Hij%spint3 = 1
+ else
+ Hij%t3 = Hij%sot3 - ngel - nocc - nligo
+ Hij%spint3 = -1
+ endif
+ nhJ = 1
+ endif
+
+ !Hole t4
+ Hij%sot4 = detJ%dettr(2)
+ if (Hij%sot4 .ne. 0) then
+ if (Hij%sot4 .le. 2*ngel + nocc + nligo) then
+ Hij%t4 = Hij%sot4 - ngel
+ Hij%spint4 = 1
+ else
+ Hij%t4 = Hij%sot4 - ngel - nocc - nligo
+ Hij%spint4 = -1
+ endif
+ nhJ = 2
+ endif
+
+ !Particule p1
+ Hij%sop1 = detI%detprt(1)
+ if (Hij%sop1 .ne. 0) then
+ if (Hij%sop1 .le. 2*ngel + 2*nocc + 2*nligo + 2*nact + nligv + nvirt) then
+ Hij%p1 = Hij%sop1 - ngel - nocc - nligo - nact
+ Hij%spinp1 = 1
+ else
+ Hij%p1 = Hij%sop1 - ngel - nocc - nligo - nact - nligv - nvirt
+ Hij%spinp1 = -1
+ endif
+ endif
+
+ !Particule p2
+ Hij%sop2 = detI%detprt(2)
+ if (Hij%sop2 .ne. 0) then
+ if (Hij%sop2 .le. 2*ngel + 2*nocc + 2*nligo + 2*nact + nligv + nvirt) then
+ Hij%p2 = Hij%sop2 - ngel - nocc - nligo - nact
+ Hij%spinp2 = 1
+ else
+ Hij%p2 = Hij%sop2 - ngel - nocc - nligo - nact - nligv - nvirt
+ Hij%spinp2 = -1
+ endif
+ endif
+
+ !Particule p3
+ Hij%sop3 = detJ%detprt(1)
+ if (Hij%sop3 .ne. 0) then
+ if (Hij%sop3 .le. 2*ngel + 2*nocc + 2*nligo + 2*nact + nligv + nvirt) then
+ Hij%p3 = Hij%sop3 - ngel - nocc - nligo - nact
+ Hij%spinp3 = 1
+ else
+ Hij%p3 = Hij%sop3 - ngel - nocc - nligo - nact - nligv - nvirt
+ Hij%spinp3 = -1
+ endif
+ endif
+
+ !Particule p4
+ Hij%sop4 = detJ%detprt(2)
+ if (Hij%sop4 .ne. 0) then
+ if (Hij%sop4 .le. 2*ngel + 2*nocc + 2*nligo + 2*nact + nligv + nvirt) then
+ Hij%p4 = Hij%sop4 - ngel - nocc - nligo - nact
+ Hij%spinp4 = 1
+ else
+ Hij%p4 = Hij%sop4 - ngel - nocc - nligo - nact - nligv - nvirt
+ Hij%spinp4 = -1
+ endif
+ endif
+
+ !Modifications du signe dûes aux permutations des orbitales virtuelles
+ if ( (Hij%sop1 == 0) .and. (Hij%sop3 == 0) ) then !0000 (P1 P2 P3 P4)
+ signp = +1
+
+ else if ( (Hij%sop1 /= 0) .and. (Hij%sop3 == 0) ) then !1?00
+ if ( Hij%sop2 == 0 ) then!1000
+ signp = (-1)**(nelact-1)
+ else !1200
+ signp = +1
+ end if
+
+ else if ( (Hij%sop1 == 0) .and. (Hij%sop3 /= 0) ) then !003?
+ if ( Hij%sop4 == 0 ) then !0030
+ signp = (-1)**(nelact-1)
+ else !0034
+ signp = +1
+ end if
+
+ else if ( (Hij%sop2 == 0) .and. (Hij%sop4 == 0) ) then !1030
+ if ( Hij%sop1 == Hij%sop3 ) then
+ signp = +1
+ else
+ signp = +1
+ end if
+
+ else if ( (Hij%sop2 /=0) .and. (Hij%sop4 == 0) ) then !1230
+ if ( Hij%sop3 == Hij%sop1 ) then
+ signp = (-1)**(nelact-1)
+ else if ( Hij%sop3 == Hij%sop2 ) then
+ signp = (-1)**nelact
+ else
+ signp = (-1)**(nelact-1)
+ end if
+
+ else if ( (Hij%sop2 == 0) .and. (Hij%sop4 /= 0) ) then !1034
+ if ( Hij%sop1 == Hij%sop3 ) then
+ signp = (-1)**(nelact-1)
+ else if ( Hij%sop1 == Hij%sop4 ) then
+ signp = (-1)**nelact
+ else
+ signp = (-1)**(nelact-1)
+ end if
+
+ else if ( (Hij%sop2 /= 0) .and. (Hij%sop4 /= 0) ) then !1234
+ if ( (Hij%sop1 == Hij%sop3) .and. (Hij%sop2 == Hij%sop4) ) then
+ signp = +1
+ else if ( Hij%sop1 == Hij%sop3 ) then
+ signp = +1
+ else if ( Hij%sop2 == Hij%sop4 ) then
+ signp = +1
+ else if ( (Hij%sop1 == Hij%sop4) .or. (Hij%sop2 == Hij%sop3) ) then
+ signp = -1
+ else
+ signp = +1
+ end if
+ end if
+
+ !Modifications du signe dûes aux permutations des orbitales occupées
+ if ( (Hij%sot1 == 0) .and. (Hij%sot3 == 0) ) then !0000 (T1 T2 T3 T4)
+ signt = +1
+
+ else if ( (Hij%sot1 /= 0) .and. (Hij%sot3 == 0) ) then !1?00
+ if ( Hij%sot2 == 0 ) then !1000
+ signt = (-1)**(Hij%sot1-1)
+ else !1200
+ signt = (-1)**(Hij%sot1+Hij%sot2)
+ end if
+
+ else if ( (Hij%sot1 == 0) .and. (Hij%sot3 /= 0) ) then !003?
+ if ( Hij%sot4 == 0 ) then !0030
+ signt = (-1)**(Hij%sot3-1)
+ else !0034
+ signt = (-1)**(Hij%sot3+Hij%sot4)
+ end if
+
+ else if ( (Hij%sot2 == 0) .and. (Hij%sot4 == 0) ) then !1030
+ if ( Hij%sot1 == Hij%sot3 ) then
+ signt = +1
+ else
+ signt = (-1)**(Hij%sot1+Hij%sot3-1)
+ end if
+
+ else if ( (Hij%sot2 /=0) .and. (Hij%sot4 == 0) ) then !1230
+ if ( Hij%sot3 == Hij%sot1 ) then
+ signt = (-1)**(Hij%sot2-1)
+ else if ( Hij%sot3 == Hij%sot2 ) then
+ signt = (-1)**Hij%sot1
+ else
+ signt = (-1)**(Hij%sot1+Hij%sot2+Hij%sot3-1)
+ end if
+
+ else if ( (Hij%sot2 == 0) .and. (Hij%sot4 /= 0) ) then !1034
+ if ( Hij%sot1 == Hij%sot3 ) then
+ signt = (-1)**(Hij%sot4-1)
+ else if ( Hij%sot1 == Hij%sot4 ) then
+ signt = (-1)**Hij%sot3
+ else
+ signt = (-1)**(Hij%sot3+Hij%sot4+Hij%sot1-1)
+ end if
+
+ else if ( (Hij%sot2 /= 0) .and. (Hij%sot4 /= 0) ) then !1234
+ if ( (Hij%sot1 == Hij%sot3) .and. (Hij%sot2 == Hij%sot4) ) then
+ signt = +1
+ else if ( Hij%sot1 == Hij%sot3 ) then
+ signt = (-1)**(Hij%sot2+Hij%sot4-1)
+ else if ( Hij%sot2 == Hij%sot4 ) then
+ signt = (-1)**(Hij%sot1+Hij%sot3-1)
+ else if ( Hij%sot1 == Hij%sot4 ) then
+ signt = (-1)**(Hij%sot2+Hij%sot3)
+ else if ( Hij%sot2 == Hij%sot3 ) then
+ signt = (-1)**(Hij%sot1+Hij%sot4)
+ else
+ signt = (-1)**(Hij%sot1+Hij%sot2+Hij%sot3+Hij%sot4)
+ end if
+ end if
+
+
+ !Active part of the determinants
+ Hij%detactI = detI%detact
+ Hij%detactJ = detJ%detact
+
+ !Get nb of differences for active parts and sign
+ call sign_diff(Hij%detactI, Hij%detactJ, diffI, diffJ, and_IJ, signact, nact)
+
+ call extract_orbindx_from_detact(diffI, ai, si, no, nact, ndiffI)
+ call extract_orbindx_from_detact(diffJ, aj, sj, no, nact, ndiffJ)
+ call extract_orbindx_from_detact(and_ij, a, s, no, nact, nandIJ)
+
+ !Get nb of differences for holes
+ if ((Hij%sot1 .ne. 0) .and. (Hij%sot1 .ne. Hij%sot3) .and. &
+ (Hij%sot1 .ne. Hij%sot4)) Ndiffh = Ndiffh + 1
+ if ((Hij%sot2 .ne. 0) .and. (Hij%sot2 .ne. Hij%sot3) .and. &
+ (Hij%sot2 .ne. Hij%sot4)) Ndiffh = Ndiffh + 1
+ if ((Hij%sot3 .ne. 0) .and. (Hij%sot1 .ne. Hij%sot3) .and. &
+ (Hij%sot2 .ne. Hij%sot3)) Ndiffh = Ndiffh + 1
+ if ((Hij%sot4 .ne. 0) .and. (Hij%sot1 .ne. Hij%sot4) .and. &
+ (Hij%sot2 .ne. Hij%sot4)) Ndiffh = Ndiffh + 1
+
+ !Get nb of differences for particules
+ if ((Hij%sop1 .ne. 0) .and. (Hij%sop1 .ne. Hij%sop3) .and. &
+ (Hij%sop1 .ne. Hij%sop4)) Ndiffp = Ndiffp + 1
+ if ((Hij%sop2 .ne. 0) .and. (Hij%sop2 .ne. Hij%sop3) .and. &
+ (Hij%sop2 .ne. Hij%sop4)) Ndiffp = Ndiffp + 1
+ if ((Hij%sop3 .ne. 0) .and. (Hij%sop1 .ne. Hij%sop3) .and. &
+ (Hij%sop2 .ne. Hij%sop3)) Ndiffp = Ndiffp + 1
+ if ((Hij%sop4 .ne. 0) .and. (Hij%sop1 .ne. Hij%sop4) .and. &
+ (Hij%sop2 .ne. Hij%sop4)) Ndiffp = Ndiffp + 1
+
+ !Total number of differences
+ Ndifftot = Ndiffp + Ndiffh + NdiffI+ NdiffJ
+
+ if (Ndifftot .eq. 0) then
+ write(iout,*) 'Diagonal Case'
+ explicit_Hij = hdiag(idet)
+ goto 100
+ else if (Ndifftot .eq. 2) then
+ write(iout,*) '1 excitation'
+ call compute_hij(elm, Hij, fock, Ndiffp, NdiffI + NdiffJ, Ndiffh, &
+ o_info, int_info, iout)
+ else if (Ndifftot .eq. 4) then
+ write(iout,*) '2 excitations'
+ call compute_hij(elm, Hij, fock, Ndiffp, NdiffI + NdiffJ, Ndiffh, &
+ o_info, int_info, iout)
+ else
+ write(iout,*) 'Zero case'
+ endif
+
+ !Compute sign
+ sign = signact * signt * (-1)**(nhI * ndiffI + nhJ * ndiffJ) *signp
+
+
+ !Printing
+ if (sign .eq. 1) then
+ write(iout,'(A)',advance='no') '+'
+ else
+ write(iout,'(A)', advance='no') '-'
+ endif
+ write(iout,'(A)',advance='no') '<'
+ if (Hij%sop2 .ne. 0 ) then
+ write(iout,'(I0)',advance='no') Hij%p2
+ if (Hij%spinp2 .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ endif
+ if (Hij%sop1 .ne. 0 ) then
+ write(iout,'(I0)',advance='no') Hij%p1
+ if (Hij%spinp1 .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ endif
+ do i = 1, ndiffI
+ write(iout,'(I0)',advance='no') ai(i)
+ if (si(i) .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ enddo
+ if (Hij%sot4 .ne. 0 ) then
+ write(iout,'(I0)',advance='no') Hij%t4
+ if (Hij%spint4 .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ endif
+ if (Hij%sot3 .ne. 0 ) then
+ write(iout,'(I0)',advance='no') Hij%t3
+ if (Hij%spint3 .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ endif
+
+ write(iout,'(A)',advance='no') 'det|H|'
+ if (Hij%sop4 .ne. 0 ) then
+ write(iout,'(I0)',advance='no') Hij%p4
+ if (Hij%spinp4 .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ endif
+ if (Hij%sop3 .ne. 0 ) then
+ write(iout,'(I0)',advance='no') Hij%p3
+ if (Hij%spinp3 .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ endif
+ do i = 1, ndiffJ
+ write(iout,'(I0)',advance='no') aj(i)
+ if (sj(i) .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ enddo
+ if (Hij%sot2 .ne. 0 ) then
+ write(iout,'(I0)',advance='no') Hij%t2
+ if (Hij%spint2 .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ endif
+ if (Hij%sot1 .ne. 0 ) then
+ write(iout,'(I0)',advance='no') Hij%t1
+ if (Hij%spint1 .eq. 1) then
+ write(iout,'(A)',advance='no') 'u '
+ else
+ write(iout,'(A)',advance='no') 'd '
+ endif
+ endif
+ write(iout,'(A)',advance='no') 'det> = '
+
+ if (sign .eq. 1) then
+ write(iout,*) elm
+ explicit_Hij = elm
+
+ else
+ write(iout,*) -elm
+ explicit_Hij = -elm
+ endif
+
+100 deallocate(a, ai, aj, s, si, sj)
+
+ end function explicit_Hij
+
+
+
+ !$====================================================================
+ !> @brief Compute explicitely the "ordered hij" where the sign has
+ !! been dealt with externally for non-zero off-diagonal terms
+ !> @author ER
+ !> @date May 2019
+ !
+ !> @param[out] elm value of the matrix element
+ !> @param Hij braket type containing the info about <I|H|J>
+ !> @param fock Fock matrix
+ !> @param Ndiffact number of difference in the active parts
+ !> @param Ndiffh Number of differences in the hole parts
+ !> @param Ndiffp Number of differences in the particle parts
+ !> @param o_info Orbital info
+ !> @param int_info Integral info
+ !> @param iout Output unit
+ !$====================================================================
+ subroutine compute_hij(elm, Hij, fock, Ndiffp, Ndiffact, Ndiffh, &
+ o_info, int_info, iout)
+
+ type(braket) :: Hij
+ integer :: Ndiffp, Ndiffact, Ndiffh, iout
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype) :: int_info
+ real(kd_dble), intent(out) :: elm
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ real(kd_dble) :: elmx, elmtmp
+
+ integer :: diff1, diff2, diff3, diff4
+ integer :: spindiff1, spindiff2, spindiff3, spindiff4
+ integer :: andp1, andp2, andt1, andt2
+ integer :: spinandp1, spinandp2, spinandt1, spinandt2
+ integer (Kind= kindact) :: diffI, diffJ, and_IJ
+ integer :: ndiffI, ndiffJ, nandIJ
+ integer, dimension(:), allocatable :: ai, aj, si, sj, a, s
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no
+ integer :: signact
+ integer :: k, sp
+
+ elm = 0.0d0
+ elmx = 0.0d0
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+
+ allocate(a(2*nact), ai(2*nact), aj(2*nact))
+ allocate(s(2*nact), si(2*nact), sj(2*nact))
+
+ diff1 = 0
+ diff2 = 0
+ diff3 = 0
+ diff4 = 0
+
+ spindiff1 = 0
+ spindiff2 = 0
+ spindiff3 = 0
+ spindiff4 = 0
+
+ andp1 = 0
+ andp2 = 0
+ andt1 = 0
+ andt2 = 0
+
+ spinandp1 = 0
+ spinandp2 = 0
+ spinandt1 = 0
+ spinandt2 = 0
+
+ !Get differences for particules
+ if (Hij%sop1 .ne. 0) then
+ if ((Hij%sop1 .ne. Hij%sop3) .and. (Hij%sop1 .ne. Hij%sop4)) then
+ diff1 = Hij%p1
+ spindiff1 = Hij%spinp1
+ else
+ andp1 = Hij%p1
+ spinandp1 = Hij%spinp1
+ endif
+
+ if (Hij%sop2 .ne. 0) then
+ if ((Hij%sop2 .ne. Hij%sop3) .and. (Hij%sop2 .ne. Hij%sop4)) then
+ if (diff1 .eq. 0) then
+ diff1 = Hij%p2
+ spindiff1 = Hij%spinp2
+ else
+ diff2 = Hij%p2
+ spindiff2 = Hij%spinp2
+ endif
+ else
+ if (andp1 .eq. 0) then
+ andp1 = Hij%p2
+ spinandp1 = Hij%spinp2
+ else
+ andp2 = Hij%p2
+ spinandp2 = Hij%spinp2
+ endif
+ endif
+ endif
+ endif
+
+ if ((Hij%sop3 .ne. 0) .and. (Hij%sop1 .ne. Hij%sop3) .and. &
+ (Hij%sop2 .ne. Hij%sop3)) then
+ diff3 = Hij%p3
+ spindiff3 = Hij%spinp3
+ endif
+ if ((Hij%sop4 .ne. 0) .and. (Hij%sop1 .ne. Hij%sop4) .and. &
+ (Hij%sop2 .ne. Hij%sop4)) then
+ if (diff3 .eq. 0) then
+ diff3 = Hij%p4
+ spindiff3 = Hij%spinp4
+ else
+ diff4 = Hij%p4
+ spindiff4 = Hij%spinp4
+ endif
+ endif
+
+ !Get differences for active
+
+ call sign_diff(Hij%detactI, Hij%detactJ, diffI, diffJ, and_IJ, signact, nact)
+
+ call extract_orbindx_from_detact(diffI, ai, si, no, nact, ndiffI)
+ call extract_orbindx_from_detact(diffJ, aj, sj, no, nact, ndiffJ)
+ call extract_orbindx_from_detact(and_ij, a, s, no, nact, nandIJ)
+
+ if (ndiffI .eq. 1) then
+ if (diff1 .eq. 0) then
+ diff1 = aI(1)
+ spindiff1 = sI(1)
+ else
+ diff2 = aI(1)
+ spindiff2 = sI(1)
+ endif
+ else if (ndiffI .eq. 2) then
+ diff1 = aI(1)
+ spindiff1 = sI(1)
+ diff2 = aI(2)
+ spindiff2 = sI(2)
+ endif
+
+ if (ndiffJ .eq. 1) then
+ if (diff3 .eq. 0) then
+ diff3 = aJ(1)
+ spindiff3 = sJ(1)
+ else
+ diff4 = aJ(1)
+ spindiff4 = sJ(1)
+ endif
+ else if (ndiffJ .eq. 2) then
+ diff3 = aJ(1)
+ spindiff3 = sJ(1)
+ diff4 = aJ(2)
+ spindiff4 = sJ(2)
+ endif
+
+ !Get differences for holes
+ if (Hij%sot1 .ne. 0) then
+ if ((Hij%sot1 .ne. Hij%sot3) .and. (Hij%sot1 .ne. Hij%sot4)) then
+ if (diff3 .eq. 0) then
+ diff3 = Hij%t1
+ spindiff3= Hij%spint1
+ else
+ diff4 = Hij%t1
+ spindiff4= Hij%spint1
+ endif
+ else
+ andt1 = Hij%t1
+ spinandt1 = Hij%spint1
+ endif
+
+ if (Hij%sot2 .ne. 0) then
+ if ((Hij%sot2 .ne. Hij%sot3) .and. (Hij%sot2 .ne. Hij%sot4)) then
+ if (diff3 .eq. 0) then
+ diff3 = Hij%t2
+ spindiff3 = Hij%spint2
+ else
+ diff4 = Hij%t2
+ spindiff4 = Hij%spint2
+ endif
+ else
+ if (andt1 .eq. 0) then
+ andt1 = Hij%t2
+ spinandt1 = Hij%spint2
+ else
+ andt2 = Hij%t2
+ spinandt2 = Hij%spint2
+ endif
+ endif
+ endif
+ endif
+
+ if ((Hij%sot3 .ne. 0) .and. (Hij%sot1 .ne. Hij%sot3) .and. &
+ (Hij%sot2 .ne. Hij%sot3)) then
+ if (diff1 .eq. 0) then
+ diff1 = Hij%t3
+ spindiff1 = Hij%spint3
+ else
+ diff2 = Hij%t3
+ spindiff2 = Hij%spint3
+ endif
+ endif
+ if ((Hij%sot4 .ne. 0) .and. (Hij%sot1 .ne. Hij%sot4) .and. &
+ (Hij%sot2 .ne. Hij%sot4)) then
+ if (diff1 .eq. 0) then
+ diff1 = Hij%t4
+ spindiff1 = Hij%spint4
+ else
+ diff2 = Hij%t4
+ spindiff2 = Hij%spint4
+ endif
+ endif
+
+
+ !Two excitation
+ if (diff2.ne.0) then
+ if (spindiff1 .eq. spindiff3) then
+ call get_explicit_int(diff1,diff3,diff2,diff4, &
+ o_info, int_info, elm,iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '<',diff1,diff2,'|',diff3,diff4,'>'
+ endif
+
+ if (spindiff1 .eq. spindiff4) then
+ call get_explicit_int(diff1,diff4,diff2,diff3, &
+ o_info, int_info, elmx, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '<',diff1,diff2,'|',diff4,diff3,'>'
+ endif
+
+ elm = elm - elmx
+ else
+ !One excitation
+ elm = fock(diff1,diff3)
+ write(iout,'(A,I4,A,I4,A)') '<',diff1,'|',diff3,'>'
+ if (andp1 .ne. 0 ) then !somme particule1
+ call get_explicit_int(diff1,diff3,andp1,andp1, &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '+<',diff1,andp1,'|',diff3,andp1,'>'
+ elm = elm + elmtmp
+ if (spindiff1 .eq. spinandp1) then
+ call get_explicit_int(diff1,andp1,diff3,andp1, &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '-<',diff1,andp1,'|',andp1,diff3,'>'
+ elm = elm - elmtmp
+ endif
+ endif
+
+ if (andp2 .ne. 0 ) then !somme particule2
+ call get_explicit_int(diff1,diff3,andp2,andp2, &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '+<',diff1,andp2,'|',diff3,andp2,'>'
+ elm = elm + elmtmp
+ if (spindiff1 .eq. spinandp2) then
+ call get_explicit_int(diff1,andp2,diff3,andp2, &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '-<',diff1,andp2,'|',andp2,diff3,'>'
+ elm = elm - elmtmp
+ endif
+ endif
+
+ if (andt1 .ne. 0 ) then !retirer le trou 1
+ call get_explicit_int(diff1,diff3,andt1,andt1, &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '-<',diff1,andt1,'|',diff3,andt1,'>'
+ elm = elm - elmtmp
+ if (spindiff1 .eq. spinandt1) then
+ call get_explicit_int(diff1,andt1,diff3,andt1, &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '+<',diff1,andt1,'|',andt1,diff3,'>'
+ elm = elm + elmtmp
+ endif
+ endif
+
+ if (andt2 .ne. 0 ) then !retirer le trou 2
+ call get_explicit_int(diff1,diff3,andt2,andt2, &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '-<',diff1,andt2,'|',diff3,andt2,'>'
+ elm = elm - elmtmp
+ if (spindiff1 .eq. spinandt2) then
+ call get_explicit_int(diff1,andt2,diff3,andt2, &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '+<',diff1,andt2,'|',andt2,diff3,'>'
+ elm = elm + elmtmp
+ endif
+ endif
+
+ do k = 1, nandIJ !somme actives
+ call get_explicit_int(diff1,diff3,a(k),a(k), &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '+<',diff1,a(k),'|',diff3,a(k),'>'
+ elm = elm + elmtmp
+ if (spindiff1 .eq. s(k)) then
+ call get_explicit_int(diff1,a(k),diff3,a(k), &
+ o_info, int_info, elmtmp, iout)
+ write(iout,'(A,I4,I4,A,I4,I4,A)') '-<',diff1,a(k),'|',a(k),diff3,'>'
+ elm = elm - elmtmp
+ endif
+ enddo
+ endif
+
+ deallocate(a, ai, aj, s, si, sj)
+
+ end subroutine compute_hij
+
+ !$====================================================================
+ !> @brief Get a specific two-electron integral from disk (m1 m2| m3 m4)
+ !! and add it to elm
+ !> @author ER
+ !> @date May 2019
+ !
+ !> @param m1
+ !> @param m2
+ !> @param m3
+ !> @param m4
+ !> @param o_info Orbital info
+ !> @param int_info Integral info
+ !> @param elm Hamiltonian matrix element being calculated
+ !> @param iout Output unit
+ !$====================================================================
+ subroutine get_explicit_int(m1,m2,m3,m4, o_info, int_info, elm, iout)
+
+ integer :: m1,m2,m3,m4, iout
+ type(o_infotype) :: o_info
+ type(int_infotype) :: int_info
+
+ integer :: n1, n2, n3, n4
+ integer :: ni, nj, nk, nl
+
+ integer :: no, na, nv
+ integer :: i
+
+ character(1) :: s1, s2, s3, s4
+ character(4) :: intname
+ character(4) :: intname2
+ character(4) :: intnamex
+ character(4) :: intnamex2
+ character(4) :: tmp
+ integer :: nintkind
+
+ type(intblock) :: twoint
+ type(intkind_H), dimension(:), allocatable :: intkindlist
+ type(intkind_H) :: intkind
+
+ real(kd_dble) :: elm
+
+ integer :: id_cpu = 0
+
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ na = no + o_info%nact
+ nv = na + o_info%nligv + o_info%nvirt
+
+ !Get the canonical ordering (ni nj| nk nl) from (m1 m2| m3 m4)
+ !such that ni >= nj, nk >= nl and ninj >= nknl
+ N1 = M1
+ N2 = M2
+ if (M1.GT.M2) GOTO 511
+ N1 = M2
+ N2 = M1
+511 N3 = M3
+ N4 = M4
+ if (M3.gt.M4) goto 512
+ N3 = M4
+ N4 = M3
+512 NI = N1
+ NJ = N2
+ NK = N3
+ NL = N4
+ if (NI.gt.NK) goto 502
+ if (NI.EQ.NK) goto 514
+ NI = N3
+ NJ = N4
+ NK = N1
+ NL = N2
+ GOTO 502
+514 if (NJ.GT.NL) goto 502
+ NL = N2
+ NJ = N4
+
+502 if (ni .gt. na) then
+ s1 = 'v'
+ else if (ni .gt. no) then
+ s1 = 'a'
+ else
+ s1 = 'o'
+ endif
+
+ if (nj .gt. na) then
+ s2 = 'v'
+ else if (nj .gt. no) then
+ s2 ='a'
+ else
+ s2 = 'o'
+ endif
+
+ if (nk .gt. na) then
+ s3 = 'v'
+ else if (nk .gt. no) then
+ s3 ='a'
+ else
+ s3 = 'o'
+ endif
+
+ if (nl .gt. na) then
+ s4 = 'v'
+ else if (nl .gt. no) then
+ s4 ='a'
+ else
+ s4 = 'o'
+ endif
+
+ intname = s1//s2//s3//s4
+ intname2 = s3//s4//s1//s2
+ intnamex = s1//s3//s2//s4
+ intnamex2 = s1//s3//s4//s2
+
+!!$ int_info%CASS_intkind &
+!!$ = (/ 'aaaa', 'aaao', 'vaaa', 'aaoo', 'vaao', 'vvaa','vaoo', &
+!!$ 'vvao','vvoo' /)
+
+!!$ (/ "utmp.aaaa", "utmp.aaoo", "utmp.vvaa", &
+!!$ "utmp.vvvv", "utmp.oooo", "utmp.vvoo", "utmp.vvvo", "utmp.vooo", &
+!!$ "utmp.vvva", "utmp.vaaa", "utmp.aaao", "utmp.aooo", "utmp.vaao", &
+!!$ "utmp.vaoo", "utmp.vvao", "utmp.aoao", "utmp.voao", "utmp.vovo", &
+!!$ "utmp.voaa", "utmp.vava", "utmp.vavo"/)
+ write(iout,*) intname, ' ', intname2,' ', intnamex
+ call intkind_H_all_init(intkindlist, int_info)
+ nintkind = int_info%CASS_nintkind
+ do i = 1, nintkind
+ tmp = int_info%CASS_intkind(i)
+ if (tmp .eq. intname) then
+ !write(*,*) 'intname',tmp
+ call get_intkind(intkindlist, intname, nintkind, intkind)
+ call get_twoint(twoint, intname, o_info, int_info, id_cpu)
+
+ elm = ijkl(twoint, ni,nj,nk,nl)
+ else if (tmp .eq. intname2) then
+ !write(*,*) 'intname2',tmp
+ call get_intkind(intkindlist, intname2, nintkind, intkind)
+ call get_twoint(twoint, intname2, o_info, int_info, id_cpu)
+ select case ( intkind%ijkl_type )
+ case (2)
+ elm = ijkl2(twoint, nk,nl,ni,nj)
+ case (1)
+ elm = ijkl1(twoint, nk,nl,ni,nj)
+ case (0)
+ elm = ijkl0(twoint, nk,nl,ni,nj)
+ end select
+ else if (tmp .eq. intnamex) then
+ !write(*,*) 'intnamex',tmp
+ call get_intkind(intkindlist, intname, nintkind, intkind)
+ call get_twoint(twoint, intname, o_info, int_info, id_cpu)
+ elm = ijkl(twoint, ni,nj,nk,nl)
+ else if (tmp .eq. intnamex2) then
+ !write(*,*) 'intnamex2',tmp
+ call get_intkind(intkindlist, intnamex2, nintkind, intkind)
+ call get_twoint(twoint, intkind%namex, o_info, int_info, id_cpu)
+ !write(*,*) intkind%namex, intkind%ijkl_type
+ !write(*,*) ni, nj, nk, nl
+ select case ( intkind%ijkl_type )
+ case (2)
+ elm = ijkl2(twoint, nk,nl,ni,nj)
+ case (1)
+ elm = ijkl1(twoint, nk,nl,ni,nj)
+ case (0)
+ elm = ijkl0(twoint, nk,nl,ni,nj)
+ end select
+ else
+ !write(*,*) tmp
+ !flush(6)
+ endif
+ enddo
+
+ !Cleanup
+ call intkind_H_all_free(intkindlist)
+ call intblock_free(twoint)
+ end subroutine get_explicit_int
+
+
+end module explicit_Hmat
diff --git a/src/files.F90 b/src/files.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8c37ef874352d4fa7d2c028085f92cd49b248392
--- /dev/null
+++ b/src/files.F90
@@ -0,0 +1,84 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+!> @brief Definition of the logical units
+
+Module files
+
+ Implicit none
+!!$ -------- Variables ----------------------------------------
+!!$ En entree
+!!$ f_input : fichier de donnees
+!!$ f_ref0 : liste des det de ref0
+!!$ En sortie
+!!$ f_output : fichier de sortie
+!!$ f_det : tous les determinants en clair
+!!$ f_bdet : tous les determinants en binaire
+!!$ f_info : variables globales x_info
+
+!!$ Autres
+!!$ f_hcore : Hcore (a voir si vraiment nécessaire)
+!!$ f_mono : fichier d'intégrales mono-électroniques
+!!$ f_fock : opérateur de Fock des dble occ + ligand occ
+!!$ f_hcore : Hcore (a voir si vraiment nécessaire)
+!!$ f_tone : TraOne
+!!$ f_tint : TraInt
+!!$ -----------------------------------------------------------
+ integer, parameter :: f_input=1, f_output=7, f_ref0=8, f_det=9, f_bdet=39
+ integer, parameter :: f_fock=10
+ integer, parameter :: f_info=24
+ integer, parameter :: f_gen=14, f_restart = 15, f_gen0 = 16
+ integer, parameter :: f_tone=31, f_tint=32, f_mat=33, f_bmat=34, f_mat2=35
+
+ integer :: f_Mono=20
+ integer :: f_aaaa=40, f_aaoo=41, f_vvaa=42
+ integer :: f_vvvv=43, f_oooo=44, f_vvoo=45, f_vvvo=46, f_vooo=47
+ integer :: f_vvva=48, f_vaaa=49, f_aaao=50, f_aooo=51, f_vaao=52
+ integer :: f_vaoo=53, f_vvao=54, f_aoao=55, f_voao=56, f_vovo=57
+ integer :: f_gel = 60
+ integer :: uf_aaaa=140, uf_aaoo=141, uf_vvaa=142
+ integer :: uf_vvvv=143, uf_oooo=144, uf_vvoo=145, uf_vvvo=146, uf_vooo=147
+ integer :: uf_vvva=148, uf_vaaa=149, uf_aaao=150, uf_aooo=151, uf_vaao=152
+ integer :: uf_vaoo=153, uf_vvao=154, uf_aoao=155, uf_voao=156, uf_vovo=157
+ integer :: uf_voaa=158, uf_vava=159, uf_vavo=160
+ integer :: f_debug=99
+
+ integer, parameter :: begunit=140, endunit=160
+ character*9, dimension(begunit:endunit) :: unitname &
+ = (/ "utmp.aaaa", "utmp.aaoo", "utmp.vvaa", &
+ "utmp.vvvv", "utmp.oooo", "utmp.vvoo", "utmp.vvvo", "utmp.vooo", &
+ "utmp.vvva", "utmp.vaaa", "utmp.aaao", "utmp.aooo", "utmp.vaao", &
+ "utmp.vaoo", "utmp.vvao", "utmp.aoao", "utmp.voao", "utmp.vovo", &
+ "utmp.voaa", "utmp.vava", "utmp.vavo"/)
+
+End Module files
+
+!!$ Local Variables:
+!!$ coding: utf-8-unix
+!!$ End:
diff --git a/src/fock.F90 b/src/fock.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d5bfe2a11af579fa054ed164c92b1384541e4516
--- /dev/null
+++ b/src/fock.F90
@@ -0,0 +1,236 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+
+
+module fockmatrix
+
+ use info
+ use utils_twoint
+ use detact
+
+ implicit none
+
+contains
+
+ !$====================================================================
+ !> @brief Add the 2e- integrals to the bare h_pq to build f_pq
+ !> @author ER
+ !> @date April 2018
+ !$====================================================================
+ subroutine build_fock(fock, hcoeur, o_info, int_info, prog_info)
+
+ Real(KIND=kd_dble), dimension(:,:), allocatable, intent(inout) :: fock
+ Real(KIND=kd_dble), dimension(:,:), allocatable, intent(in) :: hcoeur
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(prog_infotype), intent(in) :: prog_info
+
+ type(intblock) :: a, ax
+ integer :: i,j,p
+ integer :: no,na,nv,ng
+
+ ng = o_info%ngel
+ no = o_info%nocc + o_info%nligo
+ na = o_info%nact
+ nv = o_info%nvirt + o_info%nligv
+
+ fock(:,:) = hcoeur(:,:)
+
+ !OO (oo|oo)
+ call get_twoint(a,'oooo',o_info, int_info, prog_info%id_cpu)
+ do i=ng+1,ng+no
+ do j=i,ng+no
+ do p = ng+1,ng+no
+ fock(i,j) = fock(i,j) + 2*ijkl(a,i,j,p,p) - ijkl(a,i,p,j,p)
+ enddo
+ fock(j,i) = fock(i,j)
+ enddo
+ enddo
+ call intblock_free(a)
+
+ !OA (ao|oo)
+ call get_twoint(a,'aooo',o_info, int_info, prog_info%id_cpu)
+ do i=ng+no+1,ng+no+na
+ do j=ng+1,ng+no
+ do p = ng+1,ng+no
+ fock(i,j) = fock(i,j) + 2*ijkl(a,i,j,p,p) - ijkl(a,i,p,j,p)
+ enddo
+ fock(j,i) = fock(i,j)
+ enddo
+ enddo
+ call intblock_free(a)
+
+ !OV (vo|oo)
+ call get_twoint(a,'vooo',o_info, int_info, prog_info%id_cpu)
+ do i=ng+no+na+1,ng+no+na+nv
+ do j=ng+1,ng+no
+ do p = ng+1,ng+no
+ fock(i,j) = fock(i,j) + 2*ijkl(a,i,j,p,p) - ijkl(a,i,p,j,p)
+ enddo
+ fock(j,i) = fock(i,j)
+ enddo
+ enddo
+ call intblock_free(a)
+
+
+ !AA (aa|oo) (ao|ao)
+ call get_twoint(a,'aaoo',o_info, int_info, prog_info%id_cpu)
+ call get_twoint(ax,'aoao',o_info, int_info, prog_info%id_cpu)
+ do i=ng+no+1,ng+no+na
+ do j=i,ng+no+na
+ do p = ng+1,ng+no
+ fock(i,j) = fock(i,j) + 2*ijkl(a,i,j,p,p) - ijkl(ax,i,p,j,p)
+ enddo
+ fock(j,i) = fock(i,j)
+ enddo
+ enddo
+ call intblock_free(a)
+ call intblock_free(ax)
+
+ !AV (va|oo) (vo|ao)
+ call get_twoint(a,'vaoo',o_info, int_info, prog_info%id_cpu)
+ call get_twoint(ax,'voao',o_info, int_info, prog_info%id_cpu)
+ do i=ng+no+na+1,ng+no+na+nv
+ do j=ng+no+1,ng+no+na
+ do p = ng+1,ng+no
+ fock(i,j) = fock(i,j) + 2*ijkl(a,i,j,p,p) - ijkl(ax,i,p,j,p)
+ enddo
+ fock(j,i) = fock(i,j)
+ enddo
+ enddo
+ call intblock_free(a)
+ call intblock_free(ax)
+
+ !VV (vv|oo) (vo|vo)
+ call get_twoint(a,'vvoo',o_info, int_info, prog_info%id_cpu)
+ call get_twoint(ax,'vovo',o_info, int_info, prog_info%id_cpu)
+ do i=ng+no+na+1,ng+no+na+nv
+ do j=i,ng+no+na+nv
+ do p = ng+1,ng+no
+ fock(i,j) = fock(i,j) + 2*ijkl(a,i,j,p,p) - ijkl(ax,i,p,j,p)
+ enddo
+ fock(j,i) = fock(i,j)
+ enddo
+ enddo
+ call intblock_free(a)
+ call intblock_free(ax)
+
+ if ((prog_info%id_cpu .eq. 0) .and. (prog_info%iprint .gt. 1)) then
+ do i=ng+1,ng+no+na+nv
+ do j=i,ng+no+na+nv
+ write(f_fock,*) i,j,fock(i,j)
+ enddo
+ enddo
+ endif
+ end subroutine build_fock
+
+ !$====================================================================
+ !> @brief Diagonalise the Fock matrix
+ !> @author Elisa Rebolini
+ !> @date Apr 2018
+ !$====================================================================
+ subroutine diag_fock(fock, o_info)
+ real(kd_dble), dimension(:,:), allocatable :: fock
+ type(o_infotype), intent(in) :: o_info
+
+ logical :: debug = .false.
+ integer :: n, lwork, info,i
+ real(kd_dble), allocatable :: a(:,:)
+ real(kd_dble), allocatable :: wr(:), work(:)
+
+ n=o_info%ntot
+ lwork = 3*n
+ allocate(a(n,n))
+ allocate(wr(n))
+ allocate(work(lwork))
+ a(:,:) = fock(:,:)
+
+ call dsyev ('N', 'U', n, a, n, wr, work, lwork, info)
+ if (debug) then
+ write(f_output,*) 'Eigenvalues of the Fock Matrix'
+ do i = 1,n
+ write(f_output,*) i, wr(i)
+ enddo
+ endif
+
+ deallocate(a)
+ deallocate(wr)
+ deallocate(work)
+
+ end subroutine diag_fock
+
+ !$====================================================================
+ !> @brief Compute E0
+ !> @author Elisa Rebolini
+ !> @date Apr 2018
+ !$====================================================================
+ subroutine get_e0(ener_info, hcoeur, o_info, int_info, prog_info)
+
+ type(ener_infotype), intent(inout) :: ener_info
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: hcoeur
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ type(prog_infotype), intent(in) :: prog_info
+
+ integer :: no, i, j, ng
+ type(intblock) :: a
+ real(kd_dble) :: e1,e2
+
+ e1 = 0.d0
+ e2 = 0.d0
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+ call get_twoint(a,'oooo',o_info, int_info, prog_info%id_cpu)
+
+ do i = ng+1, ng+no
+ e1 = e1 + 2*hcoeur(i,i)
+ enddo
+
+ do i = ng+1,ng+no
+ do j = ng+1,ng+no
+ e2 = e2 + 2*ijkl(a,i,i,j,j) - ijkl(a,i,j,i,j)
+ enddo
+ enddo
+
+ ener_info%Ecoeur = e1+e2
+
+ if (prog_info%id_cpu.eq.0) then
+ write(f_output,*) ' One-electron energy = ',e1
+ write(f_output,*) ' Two-electron energy = ',e2
+ write(f_output,*) ' E0 = ',ener_info%Ecoeur
+ write(f_output,*) ' Pot. Nuc. = ',ener_info%potnuc
+ write(f_output,*) ' Total E = ',&
+ ener_info%potnuc + ener_info%Ecoeur
+ endif
+ call intblock_free(a)
+
+ end subroutine get_e0
+
+
+end module fockmatrix
diff --git a/src/gencode/aaaa_000_000_generated.F90 b/src/gencode/aaaa_000_000_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..21a8182805739571f2a4697f8f8634c66d02e59f
--- /dev/null
+++ b/src/gencode/aaaa_000_000_generated.F90
@@ -0,0 +1,202 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_000_000_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_000_000( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE( idetactJ, detactJ, idetactI, detactI), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ), &
+ !$OMP& FIRSTPRIVATE(isftI, ndetactI)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),andIJ(k),andIJ(k))&
+ -delta(spindiffI(1),spinandIJ(k))*&
+ ijkl2(twoint,diffI(1),andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_000_000
+
+end module aaaa_000_000_gen
diff --git a/src/gencode/aaaa_generated.F90 b/src/gencode/aaaa_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c0c0d8b653474bdb9641ca20e65baeedc1c3aaae
--- /dev/null
+++ b/src/gencode/aaaa_generated.F90
@@ -0,0 +1,61 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use aaaa_000_000_gen
+ use aaaa_p01_p01_gen1
+ use aaaa_p01_p01_gen2
+ use aaaa_p02_p02_gen1
+ use aaaa_p02_p02_gen2
+ use aaaa_p02_p02_gen3
+ use aaaa_p02_p02_gen4
+ use aaaa_p11_p11_gen
+ use aaaa_p12_p12_gen1
+ use aaaa_p12_p12_gen2
+ use aaaa_m11_m11_gen1
+ use aaaa_m11_m11_gen2
+ use aaaa_m12_m12_gen1
+ use aaaa_m12_m12_gen2
+ use aaaa_m12_m12_gen3
+ use aaaa_m12_m12_gen4
+ use aaaa_p20_p20_gen
+ use aaaa_m20_m20_gen1
+ use aaaa_m20_m20_gen2
+ use aaaa_m20_m20_gen3
+ use aaaa_m20_m20_gen4
+end module aaaa_gen
diff --git a/src/gencode/aaaa_m11_m11_generated1.F90 b/src/gencode/aaaa_m11_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..53e7d06a8f486503df810da97336cc80c73fe39d
--- /dev/null
+++ b/src/gencode/aaaa_m11_m11_generated1.F90
@@ -0,0 +1,221 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m11_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m11_m111( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-2))
+ allocate(spinandIJ(nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-2
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),andIJ(k),andIJ(k))&
+ -delta(spindiffI(1),spinandIJ(k))*&
+ ijkl2(twoint,diffI(1),andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_m11_m111
+
+end module aaaa_m11_m11_gen1
diff --git a/src/gencode/aaaa_m11_m11_generated2.F90 b/src/gencode/aaaa_m11_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b02532d95dbc4f5ac6c3579cb91cc1723936ad72
--- /dev/null
+++ b/src/gencode/aaaa_m11_m11_generated2.F90
@@ -0,0 +1,219 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m11_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m11_m112( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-2))
+ allocate(spinandIJ(nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-2
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),andIJ(k),andIJ(k))&
+ -delta(spindiffI(1),spinandIJ(k))*&
+ ijkl2(twoint,diffI(1),andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_m11_m112
+
+end module aaaa_m11_m11_gen2
diff --git a/src/gencode/aaaa_m12_m12_generated1.F90 b/src/gencode/aaaa_m12_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2ba67880992dc10cec2d0863eef7f9d6af93419d
--- /dev/null
+++ b/src/gencode/aaaa_m12_m12_generated1.F90
@@ -0,0 +1,371 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m12_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m12_m121( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_m12_m121
+
+end module aaaa_m12_m12_gen1
diff --git a/src/gencode/aaaa_m12_m12_generated2.F90 b/src/gencode/aaaa_m12_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..18b7776800980f12fa62cbfb1a36d6e393150558
--- /dev/null
+++ b/src/gencode/aaaa_m12_m12_generated2.F90
@@ -0,0 +1,569 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m12_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m12_m122( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_m12_m122
+
+end module aaaa_m12_m12_gen2
diff --git a/src/gencode/aaaa_m12_m12_generated3.F90 b/src/gencode/aaaa_m12_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..dafe89819d9d5695d54d1b73e9028f08146f5569
--- /dev/null
+++ b/src/gencode/aaaa_m12_m12_generated3.F90
@@ -0,0 +1,569 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m12_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m12_m123( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_m12_m123
+
+end module aaaa_m12_m12_gen3
diff --git a/src/gencode/aaaa_m12_m12_generated4.F90 b/src/gencode/aaaa_m12_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1c40da3f8a51f238afa31b5f80861fec716266d8
--- /dev/null
+++ b/src/gencode/aaaa_m12_m12_generated4.F90
@@ -0,0 +1,368 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m12_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m12_m124( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_m12_m124
+
+end module aaaa_m12_m12_gen4
diff --git a/src/gencode/aaaa_m20_m20_generated1.F90 b/src/gencode/aaaa_m20_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..906a83926854feb811932881eb585ecd30bc84e2
--- /dev/null
+++ b/src/gencode/aaaa_m20_m20_generated1.F90
@@ -0,0 +1,236 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m20_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m20_m201( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ detshiftI = detshiftpI
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-3))
+ allocate(spinandIJ(Nelact-3))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-3
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_m20_m201
+
+end module aaaa_m20_m20_gen1
diff --git a/src/gencode/aaaa_m20_m20_generated2.F90 b/src/gencode/aaaa_m20_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2fd345501e7a8f022466f111a3e9c0b42cf950f7
--- /dev/null
+++ b/src/gencode/aaaa_m20_m20_generated2.F90
@@ -0,0 +1,327 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m20_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m20_m202( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-3))
+ allocate(spinandIJ(Nelact-3))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-3
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-3))
+ allocate(spinandIJ(Nelact-3))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-3
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_m20_m202
+
+end module aaaa_m20_m20_gen2
diff --git a/src/gencode/aaaa_m20_m20_generated3.F90 b/src/gencode/aaaa_m20_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d4c5fb87da98b4285c16fa933cb0d53b20d686d1
--- /dev/null
+++ b/src/gencode/aaaa_m20_m20_generated3.F90
@@ -0,0 +1,327 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m20_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m20_m203( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-3))
+ allocate(spinandIJ(Nelact-3))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-3
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-3))
+ allocate(spinandIJ(Nelact-3))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-3
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_m20_m203
+
+end module aaaa_m20_m20_gen3
diff --git a/src/gencode/aaaa_m20_m20_generated4.F90 b/src/gencode/aaaa_m20_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ceb4613ccd31da017a6d09507de955ab8e7fae99
--- /dev/null
+++ b/src/gencode/aaaa_m20_m20_generated4.F90
@@ -0,0 +1,234 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_m20_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_m20_m204( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-3))
+ allocate(spinandIJ(Nelact-3))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-3
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_m20_m204
+
+end module aaaa_m20_m20_gen4
diff --git a/src/gencode/aaaa_p01_p01_generated1.F90 b/src/gencode/aaaa_p01_p01_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2b909b28dfa2e26ba6fb428711f836955cf3086b
--- /dev/null
+++ b/src/gencode/aaaa_p01_p01_generated1.F90
@@ -0,0 +1,346 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p01_p01_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p01_p011( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_p01_p011
+
+end module aaaa_p01_p01_gen1
diff --git a/src/gencode/aaaa_p01_p01_generated2.F90 b/src/gencode/aaaa_p01_p01_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..817412df31a62ee56fd46e38e6a5c50e82afe702
--- /dev/null
+++ b/src/gencode/aaaa_p01_p01_generated2.F90
@@ -0,0 +1,344 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p01_p01_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p01_p012( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_p01_p012
+
+end module aaaa_p01_p01_gen2
diff --git a/src/gencode/aaaa_p02_p02_generated1.F90 b/src/gencode/aaaa_p02_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fef3e9e468733fc52290ddd7cf48921e1745442f
--- /dev/null
+++ b/src/gencode/aaaa_p02_p02_generated1.F90
@@ -0,0 +1,832 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p02_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p02_p021( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_p02_p021
+
+end module aaaa_p02_p02_gen1
diff --git a/src/gencode/aaaa_p02_p02_generated2.F90 b/src/gencode/aaaa_p02_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9e0fbbe5f44be0b9ed8e7e2cdbd15a6b5acefed8
--- /dev/null
+++ b/src/gencode/aaaa_p02_p02_generated2.F90
@@ -0,0 +1,1437 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p02_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p02_p022( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_p02_p022
+
+end module aaaa_p02_p02_gen2
diff --git a/src/gencode/aaaa_p02_p02_generated3.F90 b/src/gencode/aaaa_p02_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8b9332669b0337ca22c48e2d14d3151461079ddc
--- /dev/null
+++ b/src/gencode/aaaa_p02_p02_generated3.F90
@@ -0,0 +1,1437 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p02_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p02_p023( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_p02_p023
+
+end module aaaa_p02_p02_gen3
diff --git a/src/gencode/aaaa_p02_p02_generated4.F90 b/src/gencode/aaaa_p02_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..932f0ced93ab7e58d09b99c7e2738a41addaa683
--- /dev/null
+++ b/src/gencode/aaaa_p02_p02_generated4.F90
@@ -0,0 +1,827 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p02_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p02_p024( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaaa_p02_p024
+
+end module aaaa_p02_p02_gen4
diff --git a/src/gencode/aaaa_p11_p11_generated.F90 b/src/gencode/aaaa_p11_p11_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ba09cbbdcc49683926568946872795f9901501e7
--- /dev/null
+++ b/src/gencode/aaaa_p11_p11_generated.F90
@@ -0,0 +1,323 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p11_p11_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p11_p11( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),andIJ(k),andIJ(k))&
+ -delta(spindiffI(1),spinandIJ(k))*&
+ ijkl2(twoint,diffI(1),andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),andIJ(k),andIJ(k))&
+ -delta(spindiffI(1),spinandIJ(k))*&
+ ijkl2(twoint,diffI(1),andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_p11_p11
+
+end module aaaa_p11_p11_gen
diff --git a/src/gencode/aaaa_p12_p12_generated1.F90 b/src/gencode/aaaa_p12_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..dbbf37902bd4dbafbaa8ce3787cac07cb0ef41b6
--- /dev/null
+++ b/src/gencode/aaaa_p12_p12_generated1.F90
@@ -0,0 +1,783 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p12_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p12_p121( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_p12_p121
+
+end module aaaa_p12_p12_gen1
diff --git a/src/gencode/aaaa_p12_p12_generated2.F90 b/src/gencode/aaaa_p12_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..7010b3376b7fcae9c1c0fc7f1c40d0b3cf5b83d2
--- /dev/null
+++ b/src/gencode/aaaa_p12_p12_generated2.F90
@@ -0,0 +1,781 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p12_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p12_p122( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_p12_p122
+
+end module aaaa_p12_p12_gen2
diff --git a/src/gencode/aaaa_p20_p20_generated.F90 b/src/gencode/aaaa_p20_p20_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..706680f5b87840a002043d472be298f0b2e17d7d
--- /dev/null
+++ b/src/gencode/aaaa_p20_p20_generated.F90
@@ -0,0 +1,754 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaaa_p20_p20_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaaa_p20_p20( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),diffI(1),diffJ(1))&
+ -delta(spinandIJ(k),spindiffJ(1))*&
+ ijkl2(twoint,andIJ(k),diffJ(1),andIJ(k),diffI(1))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +ijkl2(twoint,diffI(1),diffJ(1),diffI(2),diffJ(2))&
+ -delta(spindiffI(1),spindiffJ(2))*&
+ ijkl2(twoint,diffI(1),diffJ(2),diffJ(1),diffI(2))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaaa_p20_p20
+
+end module aaaa_p20_p20_gen
diff --git a/src/gencode/aaao_000_p11_generated.F90 b/src/gencode/aaao_000_p11_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ef843a6aabfbf3ac30b25bf430825fc2c6b72292
--- /dev/null
+++ b/src/gencode/aaao_000_p11_generated.F90
@@ -0,0 +1,300 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_000_p11_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_000_p11( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE( idetactJ, detactJ, idetactI, detactI), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ), &
+ !$OMP& FIRSTPRIVATE(isftI, ndetactI)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaao_000_p11
+
+end module aaao_000_p11_gen
diff --git a/src/gencode/aaao_generated.F90 b/src/gencode/aaao_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9d46c4f9c4315f5fb831a1290aa3f087e22b5ffa
--- /dev/null
+++ b/src/gencode/aaao_generated.F90
@@ -0,0 +1,54 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use aaao_000_p11_gen
+ use aaao_p01_p12_gen1
+ use aaao_p01_p12_gen2
+ use aaao_p01_m11_gen1
+ use aaao_p01_m11_gen2
+ use aaao_p02_m12_gen1
+ use aaao_p02_m12_gen2
+ use aaao_p02_m12_gen3
+ use aaao_p02_m12_gen4
+ use aaao_p11_p20_gen
+ use aaao_m12_m20_gen1
+ use aaao_m12_m20_gen2
+ use aaao_m12_m20_gen3
+ use aaao_m12_m20_gen4
+end module aaao_gen
diff --git a/src/gencode/aaao_m12_m20_generated1.F90 b/src/gencode/aaao_m12_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ff32feade8b109cca219a8f882d2cd81454fecb1
--- /dev/null
+++ b/src/gencode/aaao_m12_m20_generated1.F90
@@ -0,0 +1,363 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_m12_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_m12_m201( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaao_m12_m201
+
+end module aaao_m12_m20_gen1
diff --git a/src/gencode/aaao_m12_m20_generated2.F90 b/src/gencode/aaao_m12_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c8ddaa354f8d1de2ab0f4f861c459bd9864d0bcd
--- /dev/null
+++ b/src/gencode/aaao_m12_m20_generated2.F90
@@ -0,0 +1,555 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_m12_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_m12_m202( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaao_m12_m202
+
+end module aaao_m12_m20_gen2
diff --git a/src/gencode/aaao_m12_m20_generated3.F90 b/src/gencode/aaao_m12_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3ab82dcd30eea699b5a9a2f2938558ae667dfdf8
--- /dev/null
+++ b/src/gencode/aaao_m12_m20_generated3.F90
@@ -0,0 +1,555 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_m12_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_m12_m203( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaao_m12_m203
+
+end module aaao_m12_m20_gen3
diff --git a/src/gencode/aaao_m12_m20_generated4.F90 b/src/gencode/aaao_m12_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3329cffae2cc7f81921d13fdbfe3f75298fd98ff
--- /dev/null
+++ b/src/gencode/aaao_m12_m20_generated4.F90
@@ -0,0 +1,360 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_m12_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_m12_m204( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaao_m12_m204
+
+end module aaao_m12_m20_gen4
diff --git a/src/gencode/aaao_p01_m11_generated1.F90 b/src/gencode/aaao_p01_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d88669e79fbea1df550f8cd4dfdcfb9831105f57
--- /dev/null
+++ b/src/gencode/aaao_p01_m11_generated1.F90
@@ -0,0 +1,336 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p01_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p01_m111( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),spindiffI(1))*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffJ(1),diffI(2),diffI(1),t1 )&
+ +delta(spindiffJ(1),spindiffI(1))*&
+ ijkl1(twoint,diffJ(1),diffI(1),diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),spindiffI(1))*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffJ(1),diffI(2),diffI(1),t1 )&
+ +delta(spindiffJ(1),spindiffI(1))*&
+ ijkl1(twoint,diffJ(1),diffI(1),diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaao_p01_m111
+
+end module aaao_p01_m11_gen1
diff --git a/src/gencode/aaao_p01_m11_generated2.F90 b/src/gencode/aaao_p01_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d9fd70e0452fdfb751af9774032c25ee941d0713
--- /dev/null
+++ b/src/gencode/aaao_p01_m11_generated2.F90
@@ -0,0 +1,334 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p01_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p01_m112( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),spindiffI(1))*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffJ(1),diffI(2),diffI(1),t1 )&
+ +delta(spindiffJ(1),spindiffI(1))*&
+ ijkl1(twoint,diffJ(1),diffI(1),diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),spindiffI(1))*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffJ(1),diffI(2),diffI(1),t1 )&
+ +delta(spindiffJ(1),spindiffI(1))*&
+ ijkl1(twoint,diffJ(1),diffI(1),diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaao_p01_m112
+
+end module aaao_p01_m11_gen2
diff --git a/src/gencode/aaao_p01_p12_generated1.F90 b/src/gencode/aaao_p01_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..652dfec447873e25be27fc9e1519e12bed0ea214
--- /dev/null
+++ b/src/gencode/aaao_p01_p12_generated1.F90
@@ -0,0 +1,903 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p01_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p01_p121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaao_p01_p121
+
+end module aaao_p01_p12_gen1
diff --git a/src/gencode/aaao_p01_p12_generated2.F90 b/src/gencode/aaao_p01_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2369909d7b866c70db7f834053efef3affb378c2
--- /dev/null
+++ b/src/gencode/aaao_p01_p12_generated2.F90
@@ -0,0 +1,901 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p01_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p01_p122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaao_p01_p122
+
+end module aaao_p01_p12_gen2
diff --git a/src/gencode/aaao_p02_m12_generated1.F90 b/src/gencode/aaao_p02_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a0686d2603a11d8b8864a1f75f67c7ec91c13c0d
--- /dev/null
+++ b/src/gencode/aaao_p02_m12_generated1.F90
@@ -0,0 +1,975 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p02_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p02_m121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaao_p02_m121
+
+end module aaao_p02_m12_gen1
diff --git a/src/gencode/aaao_p02_m12_generated2.F90 b/src/gencode/aaao_p02_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c7ff385e4404825143bfc04711583c544853e331
--- /dev/null
+++ b/src/gencode/aaao_p02_m12_generated2.F90
@@ -0,0 +1,1723 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p02_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p02_m122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaao_p02_m122
+
+end module aaao_p02_m12_gen2
diff --git a/src/gencode/aaao_p02_m12_generated3.F90 b/src/gencode/aaao_p02_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6ccc0ed41311874c2abfcad296d8954fb3668ada
--- /dev/null
+++ b/src/gencode/aaao_p02_m12_generated3.F90
@@ -0,0 +1,1723 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p02_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p02_m123( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaao_p02_m123
+
+end module aaao_p02_m12_gen3
diff --git a/src/gencode/aaao_p02_m12_generated4.F90 b/src/gencode/aaao_p02_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d1aee1a829b2bb6a2976aee0f966114210fc3759
--- /dev/null
+++ b/src/gencode/aaao_p02_m12_generated4.F90
@@ -0,0 +1,970 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p02_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p02_m124( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffI(1),t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffI(1),andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl1(twoint,diffI(2),diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaao_p02_m124
+
+end module aaao_p02_m12_gen4
diff --git a/src/gencode/aaao_p11_p20_generated.F90 b/src/gencode/aaao_p11_p20_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1bbbb936ac8bd62f793c923478e5f81bd8d22406
--- /dev/null
+++ b/src/gencode/aaao_p11_p20_generated.F90
@@ -0,0 +1,880 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaao_p11_p20_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaao_p11_p20( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t4 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t4 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl1(twoint,andIJ(k),andIJ(k),diffJ(1),t3 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl1(twoint,andIJ(k),diffJ(1),andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(2),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(1),diffJ(2),t3 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl1(twoint,diffI(1),diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaao_p11_p20
+
+end module aaao_p11_p20_gen
diff --git a/src/gencode/aaoo_generated.F90 b/src/gencode/aaoo_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..edc0f2e0d3da41551964b41b1dcca6f8158f1e99
--- /dev/null
+++ b/src/gencode/aaoo_generated.F90
@@ -0,0 +1,54 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use aaoo_p01_p01_gen1
+ use aaoo_p01_p01_gen2
+ use aaoo_p02_p02_gen1
+ use aaoo_p02_p02_gen2
+ use aaoo_p02_p02_gen3
+ use aaoo_p02_p02_gen4
+ use aaoo_p11_p11_gen
+ use aaoo_p12_p12_gen1
+ use aaoo_p12_p12_gen2
+ use aaoo_m12_m12_gen1
+ use aaoo_m12_m12_gen2
+ use aaoo_m12_m12_gen3
+ use aaoo_m12_m12_gen4
+ use aaoo_p20_p20_gen
+end module aaoo_gen
diff --git a/src/gencode/aaoo_m12_m12_generated1.F90 b/src/gencode/aaoo_m12_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8ef0b26469591ddc83b04d2e85019595150e7c3f
--- /dev/null
+++ b/src/gencode/aaoo_m12_m12_generated1.F90
@@ -0,0 +1,492 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_m12_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_m12_m121( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaoo_m12_m121
+
+end module aaoo_m12_m12_gen1
diff --git a/src/gencode/aaoo_m12_m12_generated2.F90 b/src/gencode/aaoo_m12_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..49c9d9349325a08b8116c09aeb89ef502397e872
--- /dev/null
+++ b/src/gencode/aaoo_m12_m12_generated2.F90
@@ -0,0 +1,811 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_m12_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_m12_m122( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaoo_m12_m122
+
+end module aaoo_m12_m12_gen2
diff --git a/src/gencode/aaoo_m12_m12_generated3.F90 b/src/gencode/aaoo_m12_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ca61d18d786129626548c6720ed84fa27bbeb311
--- /dev/null
+++ b/src/gencode/aaoo_m12_m12_generated3.F90
@@ -0,0 +1,811 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_m12_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_m12_m123( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaoo_m12_m123
+
+end module aaoo_m12_m12_gen3
diff --git a/src/gencode/aaoo_m12_m12_generated4.F90 b/src/gencode/aaoo_m12_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a3910b01022e47b5742de977bb4a856353009261
--- /dev/null
+++ b/src/gencode/aaoo_m12_m12_generated4.F90
@@ -0,0 +1,489 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_m12_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_m12_m124( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaoo_m12_m124
+
+end module aaoo_m12_m12_gen4
diff --git a/src/gencode/aaoo_p01_p01_generated1.F90 b/src/gencode/aaoo_p01_p01_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b2a9311d4b189a4e7e2da0baaea1986e0e5382ee
--- /dev/null
+++ b/src/gencode/aaoo_p01_p01_generated1.F90
@@ -0,0 +1,465 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p01_p01_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p01_p011( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaoo_p01_p011
+
+end module aaoo_p01_p01_gen1
diff --git a/src/gencode/aaoo_p01_p01_generated2.F90 b/src/gencode/aaoo_p01_p01_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..850d4a28237d81baf89ddd2c3e03e1aafd3356ad
--- /dev/null
+++ b/src/gencode/aaoo_p01_p01_generated2.F90
@@ -0,0 +1,463 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p01_p01_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p01_p012( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaoo_p01_p012
+
+end module aaoo_p01_p01_gen2
diff --git a/src/gencode/aaoo_p02_p02_generated1.F90 b/src/gencode/aaoo_p02_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9087a8798212a29b1eb8e8c0478dda70ca509939
--- /dev/null
+++ b/src/gencode/aaoo_p02_p02_generated1.F90
@@ -0,0 +1,2398 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p02_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p02_p021( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaoo_p02_p021
+
+end module aaoo_p02_p02_gen1
diff --git a/src/gencode/aaoo_p02_p02_generated2.F90 b/src/gencode/aaoo_p02_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..10795eda3a90f66fb3ed000ebfaaef261f766b18
--- /dev/null
+++ b/src/gencode/aaoo_p02_p02_generated2.F90
@@ -0,0 +1,4569 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p02_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p02_p022( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaoo_p02_p022
+
+end module aaoo_p02_p02_gen2
diff --git a/src/gencode/aaoo_p02_p02_generated3.F90 b/src/gencode/aaoo_p02_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..19c39afc101b35b2efa1fcd782f68d83b6a059d2
--- /dev/null
+++ b/src/gencode/aaoo_p02_p02_generated3.F90
@@ -0,0 +1,4569 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p02_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p02_p023( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaoo_p02_p023
+
+end module aaoo_p02_p02_gen3
diff --git a/src/gencode/aaoo_p02_p02_generated4.F90 b/src/gencode/aaoo_p02_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6e2141b0b1c0a371a128166ea6285b39e5f1bdb2
--- /dev/null
+++ b/src/gencode/aaoo_p02_p02_generated4.F90
@@ -0,0 +1,2393 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p02_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p02_p024( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aaoo_p02_p024
+
+end module aaoo_p02_p02_gen4
diff --git a/src/gencode/aaoo_p11_p11_generated.F90 b/src/gencode/aaoo_p11_p11_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3559d36a9fe412df1c51877c5dfa6ce4d8788cc7
--- /dev/null
+++ b/src/gencode/aaoo_p11_p11_generated.F90
@@ -0,0 +1,444 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p11_p11_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p11_p11( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact+1))
+ allocate(spinandIJ(nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact+1
+ JK = JK +&
+ ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*delta(spindiffJ(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*delta(spindiffJ(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact+1))
+ allocate(spinandIJ(nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact+1
+ JK = JK +&
+ ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(spindiffI(1),spindiffJ(1))*&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*delta(spindiffJ(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaoo_p11_p11
+
+end module aaoo_p11_p11_gen
diff --git a/src/gencode/aaoo_p12_p12_generated1.F90 b/src/gencode/aaoo_p12_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8f517c20f86dba2662049f99ae9cb6d6d8db66dd
--- /dev/null
+++ b/src/gencode/aaoo_p12_p12_generated1.F90
@@ -0,0 +1,2349 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p12_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p12_p121( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaoo_p12_p121
+
+end module aaoo_p12_p12_gen1
diff --git a/src/gencode/aaoo_p12_p12_generated2.F90 b/src/gencode/aaoo_p12_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..347bc6c48331fd8079f257f0e1269724f637571a
--- /dev/null
+++ b/src/gencode/aaoo_p12_p12_generated2.F90
@@ -0,0 +1,2347 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p12_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p12_p122( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t4 ,andIJ(k),t2 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t3 ,andIJ(k),t1 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaoo_p12_p122
+
+end module aaoo_p12_p12_gen2
diff --git a/src/gencode/aaoo_p20_p20_generated.F90 b/src/gencode/aaoo_p20_p20_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..96f43ad40213af0bed314afdc8f0caa38628370d
--- /dev/null
+++ b/src/gencode/aaoo_p20_p20_generated.F90
@@ -0,0 +1,2320 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aaoo_p20_p20_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aaoo_p20_p20( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t2 ,andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t2 ,andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t2 ,andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t2 ,andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),1)*&
+ ijkl2(twointx,andIJ(k),t2 ,andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t4 ,t2 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t2 ,andIJ(k),t4 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t4 ,t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+2))
+ allocate(spinandIJ(Nelact+2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+2
+ JK = JK +ijkl2(twoint,andIJ(k),andIJ(k),t3 ,t1 )&
+ -delta(spinandIJ(k),-1)*&
+ ijkl2(twointx,andIJ(k),t1 ,andIJ(k),t3 )
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),diffJ(1),t3 ,t1 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t1 ,t1 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,diffI(1),diffJ(1),t2 ,t2 )&
+ +delta(spindiffI(1),-1)*&
+ ijkl2(twointx,diffI(1),t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aaoo_p20_p20
+
+end module aaoo_p20_p20_gen
diff --git a/src/gencode/aoao_000_p20_generated.F90 b/src/gencode/aoao_000_p20_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..daaa3431cd7038847a906680671e88b4d46f3c0d
--- /dev/null
+++ b/src/gencode/aoao_000_p20_generated.F90
@@ -0,0 +1,340 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aoao_000_p20_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aoao_000_p20( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE( idetactJ, detactJ, idetactI, detactI), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ), &
+ !$OMP& FIRSTPRIVATE(isftI, ndetactI)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !00UU
+ ! t4 < t3
+ do t4 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ !spint4 = 1
+ !t4 in occU+ligoU
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ !t3 in ligoU
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(3), &
+ 0 ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(1),1)*&
+ ijkl2(twoint,diffJ(1),t3 ,diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl2(twoint,diffJ(1),t4 ,diffJ(2),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !00DU
+ ! t4 < t3
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ !spint4 = 1
+ !t4 in occU+ligoU
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ !t3 in ligoD
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(3), &
+ 0 ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(1),-1)*&
+ ijkl2(twoint,diffJ(1),t3 ,diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl2(twoint,diffJ(1),t4 ,diffJ(2),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth + nocc + 1, isfth+nocc+nligo
+ !t4 in ligoU
+ do t3 = isfth+1, isfth+nocc !t3 in occD
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(3), &
+ 0 ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(1),-1)*&
+ ijkl2(twoint,diffJ(1),t3 ,diffJ(2),t4 )&
+ -delta(spindiffJ(1),1)*&
+ ijkl2(twoint,diffJ(1),t4 ,diffJ(2),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !00DD
+ ! t4 < t3
+ do t4 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ !spint4 = -1
+ !t4 in occD+ligoD
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ !t3 in ligoD
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(3), &
+ 0 ,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffJ(1),-1)*&
+ ijkl2(twoint,diffJ(1),t3 ,diffJ(2),t4 )&
+ -delta(spindiffJ(1),-1)*&
+ ijkl2(twoint,diffJ(1),t4 ,diffJ(2),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ enddo !i
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aoao_000_p20
+
+end module aoao_000_p20_gen
diff --git a/src/gencode/aoao_generated.F90 b/src/gencode/aoao_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..41c8e3f849939a65cd921bbe2cce2fb94d3d3d66
--- /dev/null
+++ b/src/gencode/aoao_generated.F90
@@ -0,0 +1,47 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aoao_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use aoao_000_p20_gen
+ use aoao_p02_m20_gen1
+ use aoao_p02_m20_gen2
+ use aoao_p02_m20_gen3
+ use aoao_p02_m20_gen4
+ use aoao_p12_m11_gen1
+ use aoao_p12_m11_gen2
+end module aoao_gen
diff --git a/src/gencode/aoao_p02_m20_generated1.F90 b/src/gencode/aoao_p02_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c6fb322e17a8c2ce721e57abba0e43e3fcb99e30
--- /dev/null
+++ b/src/gencode/aoao_p02_m20_generated1.F90
@@ -0,0 +1,453 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aoao_p02_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aoao_p02_m201( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aoao_p02_m201
+
+end module aoao_p02_m20_gen1
diff --git a/src/gencode/aoao_p02_m20_generated2.F90 b/src/gencode/aoao_p02_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..22f412c40a5a9dff86a2d098b8ae50f79b01bca2
--- /dev/null
+++ b/src/gencode/aoao_p02_m20_generated2.F90
@@ -0,0 +1,681 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aoao_p02_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aoao_p02_m202( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aoao_p02_m202
+
+end module aoao_p02_m20_gen2
diff --git a/src/gencode/aoao_p02_m20_generated3.F90 b/src/gencode/aoao_p02_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2fd37c0f0aee694db973a0ebb4376941cd37fe16
--- /dev/null
+++ b/src/gencode/aoao_p02_m20_generated3.F90
@@ -0,0 +1,681 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aoao_p02_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aoao_p02_m203( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aoao_p02_m203
+
+end module aoao_p02_m20_gen3
diff --git a/src/gencode/aoao_p02_m20_generated4.F90 b/src/gencode/aoao_p02_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fbed15f13fffa0887ac053f9bacea106f56e1794
--- /dev/null
+++ b/src/gencode/aoao_p02_m20_generated4.F90
@@ -0,0 +1,448 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aoao_p02_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aoao_p02_m204( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aoao_p02_m204
+
+end module aoao_p02_m20_gen4
diff --git a/src/gencode/aoao_p12_m11_generated1.F90 b/src/gencode/aoao_p12_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9518262e5fada079837ef85513010ad66f347e99
--- /dev/null
+++ b/src/gencode/aoao_p12_m11_generated1.F90
@@ -0,0 +1,404 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aoao_p12_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aoao_p12_m111( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aoao_p12_m111
+
+end module aoao_p12_m11_gen1
diff --git a/src/gencode/aoao_p12_m11_generated2.F90 b/src/gencode/aoao_p12_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b72b1cea8578b06773975ad7245b895678e18ea2
--- /dev/null
+++ b/src/gencode/aoao_p12_m11_generated2.F90
@@ -0,0 +1,402 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aoao_p12_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aoao_p12_m112( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t1 ,diffI(2),t2 )&
+ -delta(spindiffI(1),-1)*&
+ ijkl2(twoint,diffI(1),t2 ,diffI(2),t1 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aoao_p12_m112
+
+end module aoao_p12_m11_gen2
diff --git a/src/gencode/aooo_generated.F90 b/src/gencode/aooo_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cdbb5d3da78430c4ee5c18f0e853989d23d01363
--- /dev/null
+++ b/src/gencode/aooo_generated.F90
@@ -0,0 +1,47 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aooo_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use aooo_p01_p12_gen1
+ use aooo_p01_p12_gen2
+ use aooo_p02_m12_gen1
+ use aooo_p02_m12_gen2
+ use aooo_p02_m12_gen3
+ use aooo_p02_m12_gen4
+ use aooo_p11_p20_gen
+end module aooo_gen
diff --git a/src/gencode/aooo_p01_p12_generated1.F90 b/src/gencode/aooo_p01_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d6e51fea18f0e254c06ce3aa82530c068a1d1919
--- /dev/null
+++ b/src/gencode/aooo_p01_p12_generated1.F90
@@ -0,0 +1,1341 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aooo_p01_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aooo_p01_p121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ ! t4 < t3 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ ! t4 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ do t4 = isfth+nocc+1, t1-1
+ ! t4 < t1 < t3
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !U0DD
+ !spint3 = -1
+ !spint4 = -1
+ ! t1 < t4 < t3
+ do t4 = isfth+1, isfth+nocc+nligo
+ !t4 in occD+ligoD
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ !t3 in ligoD
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !D0UU
+ !spint3 = 1
+ !spint4 = 1
+ ! t4 < t3 < t1
+ do t4 = isfth + 1, isfth+nocc+nligo
+ !t4 in occU+ligoU
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ !t3 in ligoU
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ ! t4 < t3 < t1
+ do t3 = isfth+1, min(t1-1, isfth+nocc)
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! t4 < t1 < t3
+ do t3 = t1 + 1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ ! t4 < t3 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aooo_p01_p121
+
+end module aooo_p01_p12_gen1
diff --git a/src/gencode/aooo_p01_p12_generated2.F90 b/src/gencode/aooo_p01_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4c30361e3d92f5f9c31818ce63a813f8d371d42e
--- /dev/null
+++ b/src/gencode/aooo_p01_p12_generated2.F90
@@ -0,0 +1,1339 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aooo_p01_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aooo_p01_p122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ ! t4 < t3 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ ! t4 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ do t4 = isfth+nocc+1, t1-1
+ ! t4 < t1 < t3
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !U0DD
+ !spint3 = -1
+ !spint4 = -1
+ ! t1 < t4 < t3
+ do t4 = isfth+1, isfth+nocc+nligo
+ !t4 in occD+ligoD
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ !t3 in ligoD
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !D0UU
+ !spint3 = 1
+ !spint4 = 1
+ ! t4 < t3 < t1
+ do t4 = isfth + 1, isfth+nocc+nligo
+ !t4 in occU+ligoU
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ !t3 in ligoU
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ ! t4 < t3 < t1
+ do t3 = isfth+1, min(t1-1, isfth+nocc)
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! t4 < t1 < t3
+ do t3 = t1 + 1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ ! t4 < t3 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t4 ,t1 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aooo_p01_p122
+
+end module aooo_p01_p12_gen2
diff --git a/src/gencode/aooo_p02_m12_generated1.F90 b/src/gencode/aooo_p02_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a9ecfcd26531cca967548fcf709c25b37ca264ef
--- /dev/null
+++ b/src/gencode/aooo_p02_m12_generated1.F90
@@ -0,0 +1,1364 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aooo_p02_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aooo_p02_m121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !t2 < t1 < t3
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aooo_p02_m121
+
+end module aooo_p02_m12_gen1
diff --git a/src/gencode/aooo_p02_m12_generated2.F90 b/src/gencode/aooo_p02_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6209a364370b617161aa99cbd34f2aab4f10418b
--- /dev/null
+++ b/src/gencode/aooo_p02_m12_generated2.F90
@@ -0,0 +1,2501 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aooo_p02_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aooo_p02_m122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !t2 < t1 < t3
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !t2 < t1 < t3
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aooo_p02_m122
+
+end module aooo_p02_m12_gen2
diff --git a/src/gencode/aooo_p02_m12_generated3.F90 b/src/gencode/aooo_p02_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2537510d337dd7073bcf1589884058d27a6899dd
--- /dev/null
+++ b/src/gencode/aooo_p02_m12_generated3.F90
@@ -0,0 +1,2501 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aooo_p02_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aooo_p02_m123( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !t2 < t1 < t3
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !t2 < t1 < t3
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aooo_p02_m123
+
+end module aooo_p02_m12_gen3
diff --git a/src/gencode/aooo_p02_m12_generated4.F90 b/src/gencode/aooo_p02_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..64465a0c2612f12ae2f67d166e7fdc278fd16a62
--- /dev/null
+++ b/src/gencode/aooo_p02_m12_generated4.F90
@@ -0,0 +1,1359 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aooo_p02_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aooo_p02_m124( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !t2 < t1 < t3
+ do t3 = isfth+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffI(1),t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffI(1),t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,diffI(1),t2 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_aooo_p02_m124
+
+end module aooo_p02_m12_gen4
diff --git a/src/gencode/aooo_p11_p20_generated.F90 b/src/gencode/aooo_p11_p20_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..70bd7fc544db7cb1e7e7e570735a416d1e256f06
--- /dev/null
+++ b/src/gencode/aooo_p11_p20_generated.F90
@@ -0,0 +1,1318 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module aooo_p11_p20_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_aooo_p11_p20( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ ! t4 < t3 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ ! t4 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ do t4 = isfth+nocc+1, t1-1
+ ! t4 < t1 < t3
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !U0DD
+ !spint3 = -1
+ !spint4 = -1
+ ! t1 < t4 < t3
+ do t4 = isfth+1, isfth+nocc+nligo
+ !t4 in occD+ligoD
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ !t3 in ligoD
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !D0UU
+ !spint3 = 1
+ !spint4 = 1
+ ! t4 < t3 < t1
+ do t4 = isfth + 1, isfth+nocc+nligo
+ !t4 in occU+ligoU
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ !t3 in ligoU
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ ! t4 < t3 < t1
+ do t3 = isfth+1, min(t1-1, isfth+nocc)
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! t4 < t1 < t3
+ do t3 = t1 + 1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ ! t4 < t3 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(6), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t4 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t4 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ ! t4 < t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(8), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,diffJ(1),t3 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,diffJ(1),t1 ,t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ ! t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = max(t4+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(12), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,diffJ(1),t3 ,t1 ,t4 )&
+ -&
+ ijkl2(twoint,diffJ(1),t4 ,t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !t4
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_aooo_p11_p20
+
+end module aooo_p11_p20_gen
diff --git a/src/gencode/fock_000_000_generated.F90 b/src/gencode/fock_000_000_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c5beab66fb83f94261ccc9e8a53a2cf623645c74
--- /dev/null
+++ b/src/gencode/fock_000_000_generated.F90
@@ -0,0 +1,158 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_000_000_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_000_000( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE( idetactJ, detactJ, idetactI, detactI), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ), &
+ !$OMP& FIRSTPRIVATE(isftI, ndetactI)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_000_000
+
+end module fock_000_000_gen
diff --git a/src/gencode/fock_000_m11_generated1.F90 b/src/gencode/fock_000_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c2f6927383a47d7bdb5143c675306c1bd56998d4
--- /dev/null
+++ b/src/gencode/fock_000_m11_generated1.F90
@@ -0,0 +1,172 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_000_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_000_m111( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_000_m111
+
+end module fock_000_m11_gen1
diff --git a/src/gencode/fock_000_m11_generated2.F90 b/src/gencode/fock_000_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0b4206271733220c733996cc92ef3ee479e7fe8e
--- /dev/null
+++ b/src/gencode/fock_000_m11_generated2.F90
@@ -0,0 +1,170 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_000_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_000_m112( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_000_m112
+
+end module fock_000_m11_gen2
diff --git a/src/gencode/fock_000_p01_generated1.F90 b/src/gencode/fock_000_p01_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..eebf52339c670427d19addbb6b9494c9a5d544a6
--- /dev/null
+++ b/src/gencode/fock_000_p01_generated1.F90
@@ -0,0 +1,187 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_000_p01_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_000_p011( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_000_p011
+
+end module fock_000_p01_gen1
diff --git a/src/gencode/fock_000_p01_generated2.F90 b/src/gencode/fock_000_p01_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1e2005f458f38a83f243b531b1c1535c7b6ccbf1
--- /dev/null
+++ b/src/gencode/fock_000_p01_generated2.F90
@@ -0,0 +1,185 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_000_p01_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_000_p012( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_000_p012
+
+end module fock_000_p01_gen2
diff --git a/src/gencode/fock_000_p11_generated.F90 b/src/gencode/fock_000_p11_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9bda42fa39a3f737633471342d9a84ba4bb55941
--- /dev/null
+++ b/src/gencode/fock_000_p11_generated.F90
@@ -0,0 +1,209 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_000_p11_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_000_p11( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE( idetactJ, detactJ, idetactI, detactI), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ), &
+ !$OMP& FIRSTPRIVATE(isftI, ndetactI)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_000_p11
+
+end module fock_000_p11_gen
diff --git a/src/gencode/fock_generated.F90 b/src/gencode/fock_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9fe69e5bddaad3dcae537ed208dda67ed25a7a23
--- /dev/null
+++ b/src/gencode/fock_generated.F90
@@ -0,0 +1,106 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ use fock_000_000_gen
+ use fock_000_p01_gen1
+ use fock_000_p01_gen2
+ use fock_000_p11_gen
+ use fock_000_m11_gen1
+ use fock_000_m11_gen2
+ use fock_p01_p01_gen1
+ use fock_p01_p01_gen2
+ use fock_p01_p02_gen1
+ use fock_p01_p02_gen2
+ use fock_p01_p02_gen3
+ use fock_p01_p02_gen4
+ use fock_p01_p11_gen1
+ use fock_p01_p11_gen2
+ use fock_p01_p12_gen1
+ use fock_p01_p12_gen2
+ use fock_p01_m11_gen1
+ use fock_p01_m11_gen2
+ use fock_p01_m12_gen1
+ use fock_p01_m12_gen2
+ use fock_p01_m12_gen3
+ use fock_p01_m12_gen4
+ use fock_p02_p02_gen1
+ use fock_p02_p02_gen2
+ use fock_p02_p02_gen3
+ use fock_p02_p02_gen4
+ use fock_p02_p12_gen1
+ use fock_p02_p12_gen2
+ use fock_p02_p12_gen3
+ use fock_p02_p12_gen4
+ use fock_p02_m12_gen1
+ use fock_p02_m12_gen2
+ use fock_p02_m12_gen3
+ use fock_p02_m12_gen4
+ use fock_p11_p11_gen
+ use fock_p11_p12_gen1
+ use fock_p11_p12_gen2
+ use fock_p11_p20_gen
+ use fock_p12_p12_gen1
+ use fock_p12_p12_gen2
+ use fock_p12_p20_gen1
+ use fock_p12_p20_gen2
+ use fock_m11_m11_gen1
+ use fock_m11_m11_gen2
+ use fock_m11_m12_gen1
+ use fock_m11_m12_gen2
+ use fock_m11_m12_gen3
+ use fock_m11_m12_gen4
+ use fock_m11_m20_gen1
+ use fock_m11_m20_gen2
+ use fock_m11_m20_gen3
+ use fock_m11_m20_gen4
+ use fock_m12_m12_gen1
+ use fock_m12_m12_gen2
+ use fock_m12_m12_gen3
+ use fock_m12_m12_gen4
+ use fock_m12_m20_gen1
+ use fock_m12_m20_gen2
+ use fock_m12_m20_gen3
+ use fock_m12_m20_gen4
+ use fock_p20_p20_gen
+ use fock_m20_m20_gen1
+ use fock_m20_m20_gen2
+ use fock_m20_m20_gen3
+ use fock_m20_m20_gen4
+end module fock_gen
diff --git a/src/gencode/fock_m11_m11_generated1.F90 b/src/gencode/fock_m11_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d842337997183e3510d9623cf58fdc507aa25425
--- /dev/null
+++ b/src/gencode/fock_m11_m11_generated1.F90
@@ -0,0 +1,206 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m111( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_m11_m111
+
+end module fock_m11_m11_gen1
diff --git a/src/gencode/fock_m11_m11_generated2.F90 b/src/gencode/fock_m11_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0bc24195f196f58890cb0d573db3db37fd014bf5
--- /dev/null
+++ b/src/gencode/fock_m11_m11_generated2.F90
@@ -0,0 +1,208 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m112( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_m11_m112
+
+end module fock_m11_m11_gen2
diff --git a/src/gencode/fock_m11_m12_generated1.F90 b/src/gencode/fock_m11_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d4518ba3013b76fe501984988cc31983a961098c
--- /dev/null
+++ b/src/gencode/fock_m11_m12_generated1.F90
@@ -0,0 +1,238 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m11_m121
+
+end module fock_m11_m12_gen1
diff --git a/src/gencode/fock_m11_m12_generated2.F90 b/src/gencode/fock_m11_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2cd40a1c163028fab1786b30a6e8da19261db0d4
--- /dev/null
+++ b/src/gencode/fock_m11_m12_generated2.F90
@@ -0,0 +1,238 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m11_m122
+
+end module fock_m11_m12_gen2
diff --git a/src/gencode/fock_m11_m12_generated3.F90 b/src/gencode/fock_m11_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8b3ba6262fc326ea962f7f2276618c99dacac655
--- /dev/null
+++ b/src/gencode/fock_m11_m12_generated3.F90
@@ -0,0 +1,238 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m123( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m11_m123
+
+end module fock_m11_m12_gen3
diff --git a/src/gencode/fock_m11_m12_generated4.F90 b/src/gencode/fock_m11_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f9497ff42fbfc1469868dfd68157d2d735baeb1c
--- /dev/null
+++ b/src/gencode/fock_m11_m12_generated4.F90
@@ -0,0 +1,237 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m124( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m11_m124
+
+end module fock_m11_m12_gen4
diff --git a/src/gencode/fock_m11_m20_generated1.F90 b/src/gencode/fock_m11_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..392a338646987ba4c744e0e05d2c1bd0a0de8843
--- /dev/null
+++ b/src/gencode/fock_m11_m20_generated1.F90
@@ -0,0 +1,224 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m201( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ detshiftI = detshiftpI
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m11_m201
+
+end module fock_m11_m20_gen1
diff --git a/src/gencode/fock_m11_m20_generated2.F90 b/src/gencode/fock_m11_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..dffa73508e0ee580ebb23ec7c126a2ba58739ed6
--- /dev/null
+++ b/src/gencode/fock_m11_m20_generated2.F90
@@ -0,0 +1,224 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m202( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m11_m202
+
+end module fock_m11_m20_gen2
diff --git a/src/gencode/fock_m11_m20_generated3.F90 b/src/gencode/fock_m11_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f264d48b46ef781c351586f556ec60ca48b5444b
--- /dev/null
+++ b/src/gencode/fock_m11_m20_generated3.F90
@@ -0,0 +1,224 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m203( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m11_m203
+
+end module fock_m11_m20_gen3
diff --git a/src/gencode/fock_m11_m20_generated4.F90 b/src/gencode/fock_m11_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bd88f45c0221488b2ab58fd271e8749952791d47
--- /dev/null
+++ b/src/gencode/fock_m11_m20_generated4.F90
@@ -0,0 +1,223 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m11_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m11_m204( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m11_m204
+
+end module fock_m11_m20_gen4
diff --git a/src/gencode/fock_m12_m12_generated1.F90 b/src/gencode/fock_m12_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4be6779708e7253551bc61fff493dba39a5cde77
--- /dev/null
+++ b/src/gencode/fock_m12_m12_generated1.F90
@@ -0,0 +1,579 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m12_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m12_m121( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m12_m121
+
+end module fock_m12_m12_gen1
diff --git a/src/gencode/fock_m12_m12_generated2.F90 b/src/gencode/fock_m12_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bd9d7053d4eec4269671695c04dcaaf5805220de
--- /dev/null
+++ b/src/gencode/fock_m12_m12_generated2.F90
@@ -0,0 +1,968 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m12_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m12_m122( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m12_m122
+
+end module fock_m12_m12_gen2
diff --git a/src/gencode/fock_m12_m12_generated3.F90 b/src/gencode/fock_m12_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..52e3fa18957b22aebd3a06e4f4824dc1e1b9e0b7
--- /dev/null
+++ b/src/gencode/fock_m12_m12_generated3.F90
@@ -0,0 +1,968 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m12_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m12_m123( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m12_m123
+
+end module fock_m12_m12_gen3
diff --git a/src/gencode/fock_m12_m12_generated4.F90 b/src/gencode/fock_m12_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a9a1978532877f5354acd6b5ae2a25dc2299769e
--- /dev/null
+++ b/src/gencode/fock_m12_m12_generated4.F90
@@ -0,0 +1,660 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m12_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m12_m124( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m12_m124
+
+end module fock_m12_m12_gen4
diff --git a/src/gencode/fock_m12_m20_generated1.F90 b/src/gencode/fock_m12_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..69ab8104a3d6315ad7235e39283c3e32f8d92ede
--- /dev/null
+++ b/src/gencode/fock_m12_m20_generated1.F90
@@ -0,0 +1,406 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m12_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m12_m201( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ !*** p4 > p2
+ !p3<p1<p2<p4
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ if (p2 .le. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ if (p2 .le. isftp + nligv) then
+ p3 = p2
+ !p1<p2=p3<p4
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv
+ if (p2 .gt. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in virt
+ enddo !p4
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ !*** p4 > p2
+ !p3<p1<p2<p4
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ if (p2 .le. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ if (p2 .le. isftp + nligv) then
+ p3 = p2
+ !p1<p2=p3<p4
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv
+ if (p2 .gt. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in virt
+ enddo !p4
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m12_m201
+
+end module fock_m12_m20_gen1
diff --git a/src/gencode/fock_m12_m20_generated2.F90 b/src/gencode/fock_m12_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cc2ad7d815283ad4cea3db672d6d98b03ad73f84
--- /dev/null
+++ b/src/gencode/fock_m12_m20_generated2.F90
@@ -0,0 +1,610 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m12_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m12_m202( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m12_m202
+
+end module fock_m12_m20_gen2
diff --git a/src/gencode/fock_m12_m20_generated3.F90 b/src/gencode/fock_m12_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f15a8efccc3f125e5c78566da7fe43818093d8a1
--- /dev/null
+++ b/src/gencode/fock_m12_m20_generated3.F90
@@ -0,0 +1,610 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m12_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m12_m203( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m12_m203
+
+end module fock_m12_m20_gen3
diff --git a/src/gencode/fock_m12_m20_generated4.F90 b/src/gencode/fock_m12_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d6b0748ddd059c804153ea0070a271d0ab9cfa73
--- /dev/null
+++ b/src/gencode/fock_m12_m20_generated4.F90
@@ -0,0 +1,405 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m12_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m12_m204( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ enddo !p3
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m12_m204
+
+end module fock_m12_m20_gen4
diff --git a/src/gencode/fock_m20_m20_generated1.F90 b/src/gencode/fock_m20_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f4ddff7329cd1c0b2b40788201fe1e7717c1176f
--- /dev/null
+++ b/src/gencode/fock_m20_m20_generated1.F90
@@ -0,0 +1,287 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m20_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m20_m201( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ detshiftI = detshiftpI
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m20_m201
+
+end module fock_m20_m20_gen1
diff --git a/src/gencode/fock_m20_m20_generated2.F90 b/src/gencode/fock_m20_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..79cc8315bc9624e5e0ef0a89ea505c2074f8161d
--- /dev/null
+++ b/src/gencode/fock_m20_m20_generated2.F90
@@ -0,0 +1,421 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m20_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m20_m202( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m20_m202
+
+end module fock_m20_m20_gen2
diff --git a/src/gencode/fock_m20_m20_generated3.F90 b/src/gencode/fock_m20_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0e8797c52071b0894f5b235035502560c284d2e4
--- /dev/null
+++ b/src/gencode/fock_m20_m20_generated3.F90
@@ -0,0 +1,421 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m20_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m20_m203( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m20_m203
+
+end module fock_m20_m20_gen3
diff --git a/src/gencode/fock_m20_m20_generated4.F90 b/src/gencode/fock_m20_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e03f5c192918ba5835bbba65a9af993a5749e3ec
--- /dev/null
+++ b/src/gencode/fock_m20_m20_generated4.F90
@@ -0,0 +1,311 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_m20_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_m20_m204( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_m20_m204
+
+end module fock_m20_m20_gen4
diff --git a/src/gencode/fock_p01_m11_generated1.F90 b/src/gencode/fock_p01_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1148d0621804119d71796d989da58d1481bb25ba
--- /dev/null
+++ b/src/gencode/fock_p01_m11_generated1.F90
@@ -0,0 +1,273 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_m111( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 > p1
+ do p3 = p1+1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ enddo !p3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 > p1
+ do p3 = p1+1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ enddo !p3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p01_m111
+
+end module fock_p01_m11_gen1
diff --git a/src/gencode/fock_p01_m11_generated2.F90 b/src/gencode/fock_p01_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d7395f5defb5c66815ed81a9db1bda413f4a4fec
--- /dev/null
+++ b/src/gencode/fock_p01_m11_generated2.F90
@@ -0,0 +1,271 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_m112( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 < p1
+ do p3 = p1+1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ enddo !p3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 < p1
+ do p3 = p1+1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ enddo !p3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p01_m112
+
+end module fock_p01_m11_gen2
diff --git a/src/gencode/fock_p01_m12_generated1.F90 b/src/gencode/fock_p01_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1228c9ed840f94910202035010e972b0807edc72
--- /dev/null
+++ b/src/gencode/fock_p01_m12_generated1.F90
@@ -0,0 +1,364 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_m121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p01_m121
+
+end module fock_p01_m12_gen1
diff --git a/src/gencode/fock_p01_m12_generated2.F90 b/src/gencode/fock_p01_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..59ed47083f0f7f43375ea8d80285734fbeeedd91
--- /dev/null
+++ b/src/gencode/fock_p01_m12_generated2.F90
@@ -0,0 +1,364 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_m122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p01_m122
+
+end module fock_p01_m12_gen2
diff --git a/src/gencode/fock_p01_m12_generated3.F90 b/src/gencode/fock_p01_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b3b6e39c76b8b8667770c62edfccfa35a3172b0e
--- /dev/null
+++ b/src/gencode/fock_p01_m12_generated3.F90
@@ -0,0 +1,364 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_m123( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p01_m123
+
+end module fock_p01_m12_gen3
diff --git a/src/gencode/fock_p01_m12_generated4.F90 b/src/gencode/fock_p01_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..21229a51f6108da32a69b2681745e9d7181d8523
--- /dev/null
+++ b/src/gencode/fock_p01_m12_generated4.F90
@@ -0,0 +1,363 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_m124( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p01_m124
+
+end module fock_p01_m12_gen4
diff --git a/src/gencode/fock_p01_p01_generated1.F90 b/src/gencode/fock_p01_p01_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..396a19ea8c7196f267da2a8a3955855ddb6552b0
--- /dev/null
+++ b/src/gencode/fock_p01_p01_generated1.F90
@@ -0,0 +1,390 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p01_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p011( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p01_p011
+
+end module fock_p01_p01_gen1
diff --git a/src/gencode/fock_p01_p01_generated2.F90 b/src/gencode/fock_p01_p01_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8e36b3ec9f3fb8bb9342a169f981a37e0825af3d
--- /dev/null
+++ b/src/gencode/fock_p01_p01_generated2.F90
@@ -0,0 +1,404 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p01_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p012( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 dn
+ !spint3 = -1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p01_p012
+
+end module fock_p01_p01_gen2
diff --git a/src/gencode/fock_p01_p02_generated1.F90 b/src/gencode/fock_p01_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8232e97f620fee2dde8309434bf9a7699b255f28
--- /dev/null
+++ b/src/gencode/fock_p01_p02_generated1.F90
@@ -0,0 +1,522 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p021( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !UUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !UUD0
+ !spint3 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p01_p021
+
+end module fock_p01_p02_gen1
diff --git a/src/gencode/fock_p01_p02_generated2.F90 b/src/gencode/fock_p01_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..46363e411f7253291267dc1e3fba738a10fde0f5
--- /dev/null
+++ b/src/gencode/fock_p01_p02_generated2.F90
@@ -0,0 +1,522 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p022( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p01_p022
+
+end module fock_p01_p02_gen2
diff --git a/src/gencode/fock_p01_p02_generated3.F90 b/src/gencode/fock_p01_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..583c7a5b18afa91876341601471049ac801ffb4a
--- /dev/null
+++ b/src/gencode/fock_p01_p02_generated3.F90
@@ -0,0 +1,522 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p023( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p01_p023
+
+end module fock_p01_p02_gen3
diff --git a/src/gencode/fock_p01_p02_generated4.F90 b/src/gencode/fock_p01_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6011e98125a489ea6f5b573950bf28506f9e2338
--- /dev/null
+++ b/src/gencode/fock_p01_p02_generated4.F90
@@ -0,0 +1,521 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p024( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p01_p024
+
+end module fock_p01_p02_gen4
diff --git a/src/gencode/fock_p01_p11_generated1.F90 b/src/gencode/fock_p01_p11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3cdfc7ab8812a06da8ea952c5a76fbadc0701d9f
--- /dev/null
+++ b/src/gencode/fock_p01_p11_generated1.F90
@@ -0,0 +1,251 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p111( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p01_p111
+
+end module fock_p01_p11_gen1
diff --git a/src/gencode/fock_p01_p11_generated2.F90 b/src/gencode/fock_p01_p11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a2da88ae65b17e09f7847e5ba2a30563d7a7d3ea
--- /dev/null
+++ b/src/gencode/fock_p01_p11_generated2.F90
@@ -0,0 +1,249 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p112( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p01_p112
+
+end module fock_p01_p11_gen2
diff --git a/src/gencode/fock_p01_p12_generated1.F90 b/src/gencode/fock_p01_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..dc9079b12e3727d653ea4f2a8ce88f4bb83a85f3
--- /dev/null
+++ b/src/gencode/fock_p01_p12_generated1.F90
@@ -0,0 +1,606 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ !p3 > p1
+ do p3 = p1+1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ enddo !p3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 > p1
+ do p3 = p1+1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p01_p121
+
+end module fock_p01_p12_gen1
diff --git a/src/gencode/fock_p01_p12_generated2.F90 b/src/gencode/fock_p01_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0b6330f89529cf239f6beefb7ecfbe190fcbe6b0
--- /dev/null
+++ b/src/gencode/fock_p01_p12_generated2.F90
@@ -0,0 +1,604 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p01_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p01_p122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ !p3 < p1
+ do p3 = p1+1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ enddo !p3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 < p1
+ do p3 = p1+1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(11)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p01_p122
+
+end module fock_p01_p12_gen2
diff --git a/src/gencode/fock_p02_m12_generated1.F90 b/src/gencode/fock_p02_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..739e854e51c0aaec90d61d1f6b82711b3238b6f8
--- /dev/null
+++ b/src/gencode/fock_p02_m12_generated1.F90
@@ -0,0 +1,1026 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_m121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ !p3<p1<p2<p4
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then
+ p3 = p2
+ !p1<p2=p3<p4
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv
+ if (p2 .gt. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ endif !p2 in virt
+ enddo !p4
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ !p3<p1<p2<p4
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then
+ p3 = p2
+ !p1<p2=p3<p4
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv
+ if (p2 .gt. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in virt
+ enddo !p4
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ !p3<p1<p2<p4
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then
+ p3 = p2
+ !p1<p2=p3<p4
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv
+ if (p2 .gt. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in virt
+ enddo !p4
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ !p3<p1<p2<p4
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then
+ p3 = p2
+ !p1<p2=p3<p4
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ do p4 = isftp + 1, isftp + nligv
+ if (p2 .gt. isftp + nligv) then
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ endif !p2 in virt
+ enddo !p4
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_m121
+
+end module fock_p02_m12_gen1
diff --git a/src/gencode/fock_p02_m12_generated2.F90 b/src/gencode/fock_p02_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1d80702b47ce7f5510674f63c57ea787e09fec92
--- /dev/null
+++ b/src/gencode/fock_p02_m12_generated2.F90
@@ -0,0 +1,1698 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_m122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_m122
+
+end module fock_p02_m12_gen2
diff --git a/src/gencode/fock_p02_m12_generated3.F90 b/src/gencode/fock_p02_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..22a6ec8f9b748c2b60bbfc68519bd80ae6e22ece
--- /dev/null
+++ b/src/gencode/fock_p02_m12_generated3.F90
@@ -0,0 +1,1698 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_m123( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p3 = p1 + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p4
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p3
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ !Case p3 in virtU and p4 in ligvD
+ do p3 = p1 + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !*** p4 > p2
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = p2+1, isftp + nligv
+ !p1=p3<p2<p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p4
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p1<p3<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p3
+ !*** p4 > p2
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_m123
+
+end module fock_p02_m12_gen3
diff --git a/src/gencode/fock_p02_m12_generated4.F90 b/src/gencode/fock_p02_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..306e7463459b6dbfa455cc1989d5945f8f4ed940
--- /dev/null
+++ b/src/gencode/fock_p02_m12_generated4.F90
@@ -0,0 +1,1041 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_m124( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !p3
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ enddo !p3
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t1 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t2 ,diffI(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p1<p3<p4=p2
+ do p3 = p1 + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(26)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !p3
+ do p4 = p2 + 1, isftp + nligv + nvirt
+ !p1=p3<p2<p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(23)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p1<p2=p3<p4
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(29)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ endif !p2 in ligv
+ enddo !p4
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_m124
+
+end module fock_p02_m12_gen4
diff --git a/src/gencode/fock_p02_p02_generated1.F90 b/src/gencode/fock_p02_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fe6e48d7e1a5e658de66a73d3dc8dc22458c32b7
--- /dev/null
+++ b/src/gencode/fock_p02_p02_generated1.F90
@@ -0,0 +1,1854 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_p021( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_p021
+
+end module fock_p02_p02_gen1
diff --git a/src/gencode/fock_p02_p02_generated2.F90 b/src/gencode/fock_p02_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cafb3f727541eb9dd7b71353edc145e12be0746f
--- /dev/null
+++ b/src/gencode/fock_p02_p02_generated2.F90
@@ -0,0 +1,3415 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_p022( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_p022
+
+end module fock_p02_p02_gen2
diff --git a/src/gencode/fock_p02_p02_generated3.F90 b/src/gencode/fock_p02_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e37d0bb4731d057237d0ca13d7349b3cbfb61ccd
--- /dev/null
+++ b/src/gencode/fock_p02_p02_generated3.F90
@@ -0,0 +1,3415 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_p023( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_p023
+
+end module fock_p02_p02_gen3
diff --git a/src/gencode/fock_p02_p02_generated4.F90 b/src/gencode/fock_p02_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..abd7f0bdc92c893b8ea7b537988b1ca355f983f8
--- /dev/null
+++ b/src/gencode/fock_p02_p02_generated4.F90
@@ -0,0 +1,2165 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_p024( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p2 ,p4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_p024
+
+end module fock_p02_p02_gen4
diff --git a/src/gencode/fock_p02_p12_generated1.F90 b/src/gencode/fock_p02_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2a561ca4b5d0481b8350443a9365bb50707e6704
--- /dev/null
+++ b/src/gencode/fock_p02_p12_generated1.F90
@@ -0,0 +1,868 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_p121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_p121
+
+end module fock_p02_p12_gen1
diff --git a/src/gencode/fock_p02_p12_generated2.F90 b/src/gencode/fock_p02_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d0e32253173c4b6191dcdda08d188d9ba6a024c7
--- /dev/null
+++ b/src/gencode/fock_p02_p12_generated2.F90
@@ -0,0 +1,868 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_p122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_p122
+
+end module fock_p02_p12_gen2
diff --git a/src/gencode/fock_p02_p12_generated3.F90 b/src/gencode/fock_p02_p12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..806111f12b5ebcf78684b0f4e693e460958746cd
--- /dev/null
+++ b/src/gencode/fock_p02_p12_generated3.F90
@@ -0,0 +1,868 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_p12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_p123( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_p123
+
+end module fock_p02_p12_gen3
diff --git a/src/gencode/fock_p02_p12_generated4.F90 b/src/gencode/fock_p02_p12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..35d9cd814448098091b5849efd2dc44bea7c30b6
--- /dev/null
+++ b/src/gencode/fock_p02_p12_generated4.F90
@@ -0,0 +1,867 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p02_p12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p02_p124( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p2 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_fock_p02_p124
+
+end module fock_p02_p12_gen4
diff --git a/src/gencode/fock_p11_p11_generated.F90 b/src/gencode/fock_p11_p11_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8deff3e5dfc7b60bcce4c9cead53d9922b62250e
--- /dev/null
+++ b/src/gencode/fock_p11_p11_generated.F90
@@ -0,0 +1,293 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p11_p11_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p11_p11( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p11_p11
+
+end module fock_p11_p11_gen
diff --git a/src/gencode/fock_p11_p12_generated1.F90 b/src/gencode/fock_p11_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2b6b95a6aa696cf9f5370d3ec8c56560c32ce233
--- /dev/null
+++ b/src/gencode/fock_p11_p12_generated1.F90
@@ -0,0 +1,347 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p11_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p11_p121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p11_p121
+
+end module fock_p11_p12_gen1
diff --git a/src/gencode/fock_p11_p12_generated2.F90 b/src/gencode/fock_p11_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8860bfc0edc08cc8c021a1e884cf52358c2fa8bd
--- /dev/null
+++ b/src/gencode/fock_p11_p12_generated2.F90
@@ -0,0 +1,345 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p11_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p11_p122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !DUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t1 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,t2 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p11_p122
+
+end module fock_p11_p12_gen2
diff --git a/src/gencode/fock_p11_p20_generated.F90 b/src/gencode/fock_p11_p20_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9605f453f40aab03b6b361ff51b196bea60ee0bd
--- /dev/null
+++ b/src/gencode/fock_p11_p20_generated.F90
@@ -0,0 +1,519 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p11_p20_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p11_p20( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t4 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(t3 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p11_p20
+
+end module fock_p11_p20_gen
diff --git a/src/gencode/fock_p12_p12_generated1.F90 b/src/gencode/fock_p12_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3bde3cbbe7709029a5b549514316558e3f2a0d0c
--- /dev/null
+++ b/src/gencode/fock_p12_p12_generated1.F90
@@ -0,0 +1,1271 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p12_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p12_p121( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p12_p121
+
+end module fock_p12_p12_gen1
diff --git a/src/gencode/fock_p12_p12_generated2.F90 b/src/gencode/fock_p12_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8eadb3410e637ba9b9cf1f551b7e0a4f481d6834
--- /dev/null
+++ b/src/gencode/fock_p12_p12_generated2.F90
@@ -0,0 +1,1338 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p12_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p12_p122( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(p1 ,p3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p12_p122
+
+end module fock_p12_p12_gen2
diff --git a/src/gencode/fock_p12_p20_generated1.F90 b/src/gencode/fock_p12_p20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..77789ba8da47598bd9809b726c7521c925c60e48
--- /dev/null
+++ b/src/gencode/fock_p12_p20_generated1.F90
@@ -0,0 +1,520 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p12_p20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p12_p201( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p12_p201
+
+end module fock_p12_p20_gen1
diff --git a/src/gencode/fock_p12_p20_generated2.F90 b/src/gencode/fock_p12_p20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..03fdedc404ac2c8f0b3f8cc71cfae52a8b3bd28c
--- /dev/null
+++ b/src/gencode/fock_p12_p20_generated2.F90
@@ -0,0 +1,518 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p12_p20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p12_p202( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(fock), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(p1 ,diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p12_p202
+
+end module fock_p12_p20_gen2
diff --git a/src/gencode/fock_p20_p20_generated.F90 b/src/gencode/fock_p20_p20_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..baf6dc6d6685ee7b4f7abd083faaa63db2481cd4
--- /dev/null
+++ b/src/gencode/fock_p20_p20_generated.F90
@@ -0,0 +1,989 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module fock_p20_p20_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_fock_p20_p20( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t2 ,t4 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ elm = psign * tsign * fock(t1 ,t3 )
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * fock(diffI(1),diffJ(1))
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_fock_p20_p20
+
+end module fock_p20_p20_gen
diff --git a/src/gencode/generated.F90 b/src/gencode/generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bd6c03585d364d3c3fd68933f510296b6e26a24f
--- /dev/null
+++ b/src/gencode/generated.F90
@@ -0,0 +1,9646 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hdiag.x: DO NOT EDIT!
+module codegen_hdiag
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use gener_guess
+
+ implicit none
+
+contains
+
+ subroutine build_hdiag_gen(hdiag, rspin, d, fock, o_info, int_info, &
+ nelact, prog_info)
+
+ Real(kd_dble), dimension(:), allocatable, intent(inout) :: hdiag
+ type(spinrlist), intent(in) :: rspin
+ type(deter_dblocklist), intent(in) :: d
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ type(o_infotype), intent(in) :: o_info
+ type(int_infotype), intent(in) :: int_info
+ integer, intent(in) :: nelact
+ type(prog_infotype), intent(in) :: prog_info
+
+ integer, parameter :: nintkind = 6
+ character(2), dimension(nintkind) :: &
+ intkindnamelist = (/ 'aa', 'oo', 'vv', 'ov', 'oa', 'av' /)
+ type(intkind_JK_p), pointer :: intkindlist(:)
+ type(intkind_JK) :: intkind
+ integer :: i, idblock, blockname, indx, spinindx, ndet
+ type(deter_dblock), pointer :: Dblock
+ type(spindetact_list), pointer :: spinref
+ type(intblock) :: twoint, twointx
+
+ !Initialisation
+ hdiag(:) = 0.d0
+ call intkind_JK_all_init(intkindlist,intkindnamelist,nintkind)
+
+ !Fock
+ !Get the determinant block
+ do indx = 1, d%nblock
+ Dblock => d%detblock(indx)%p
+ ndet = Dblock%ndet
+
+ if (ndet.ne.0) then
+ !Get the Active parts
+ spinindx = get_Rspinindx(dblock%nelCAS)
+ spinref => rspin%l(spinindx)%p
+ call hdiag_fock(hdiag, spinref, dblock, fock, o_info, nelact, dblock%shift)
+ endif
+ enddo
+ do i =1,nintkind
+ intkind = intkindlist(i)%p
+ call get_twoint(twoint, intkind%intname, o_info, int_info, prog_info%id_cpu)
+ if (intkind%lintx) then
+ call get_twoint(twointx, intkind%intxname, o_info, int_info, prog_info%id_cpu)
+ endif
+ do idblock = 1, intkind%ndblock
+ blockname = intkind%dnamelist(idblock)
+ indx = get_deter_block_index(d,blockname)
+ Dblock => d%detblock(indx)%p
+
+ ndet = Dblock%ndet
+
+ if (ndet.ne.0) then
+ !Get the Active parts
+ spinindx = get_Rspinindx(dblock%nelCAS)
+ spinref => rspin%l(spinindx)%p
+ call hdiag_intkind_dblock(hdiag, spinref, dblock, intkind, o_info, &
+ blockname, twoint, twointx, nelact)
+ endif
+ enddo !Loop over the determinant blocks
+ call intblock_free(twoint)
+ if (intkind%lintx) then
+ call intblock_free(twointx)
+ endif
+ enddo !Loop over integral blocks
+ call intkind_JK_all_free(intkindlist,nintkind)
+ end subroutine build_hdiag_gen
+
+ subroutine hdiag_intkind_dblock(hdiag, spinref, dblock, intkind, o_info, &
+ blockname, twoint, twointx, nelact)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(intkind_JK) :: intkind
+ type(o_infotype), intent(in) :: o_info
+ type(intblock) :: twoint, twointx
+ integer, intent(in) :: blockname, nelact
+
+ select case (intkind%name)
+ case ('aa')
+ select case (blockname)
+ case (0)
+ call hdiag_aa_000(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (1)
+ call hdiag_aa_p01(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (2)
+ call hdiag_aa_p02(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (11)
+ call hdiag_aa_p11(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (12)
+ call hdiag_aa_p12(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (-11)
+ call hdiag_aa_m11(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (-12)
+ call hdiag_aa_m12(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (20)
+ call hdiag_aa_p20(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (-20)
+ call hdiag_aa_m20(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ end select
+
+ case ('oo')
+ select case (blockname)
+ case (2)
+ call hdiag_oo_p02(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (12)
+ call hdiag_oo_p12(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (20)
+ call hdiag_oo_p20(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ end select
+
+ case ('vv')
+ select case (blockname)
+ case (2)
+ call hdiag_vv_p02(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (-12)
+ call hdiag_vv_m12(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ case (-20)
+ call hdiag_vv_m20(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+ end select
+
+ case ('ov')
+ select case (blockname)
+ case (1)
+ call hdiag_ov_p01(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (2)
+ call hdiag_ov_p02(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (12)
+ call hdiag_ov_p12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (-12)
+ call hdiag_ov_m12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ end select
+
+ case ('oa')
+ select case (blockname)
+ case (1)
+ call hdiag_oa_p01(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (2)
+ call hdiag_oa_p02(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (11)
+ call hdiag_oa_p11(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (12)
+ call hdiag_oa_p12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (-12)
+ call hdiag_oa_m12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (20)
+ call hdiag_oa_p20(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ end select
+
+ case ('av')
+ select case (blockname)
+ case (1)
+ call hdiag_av_p01(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (2)
+ call hdiag_av_p02(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (12)
+ call hdiag_av_p12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (-11)
+ call hdiag_av_m11(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (-12)
+ call hdiag_av_m12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ case (-20)
+ call hdiag_av_m20(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+ end select
+
+ end select
+ end subroutine hdiag_intkind_dblock
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block 000 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_000(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ detshiftp = dblock%shift
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ deallocate(a)
+ deallocate(s)
+
+ end subroutine hdiag_aa_000
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p01 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_p01(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_aa_p01
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p02 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_p02(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(9) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(9)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(10)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(11)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(12) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(12)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(13) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(13)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(14)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(15)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(16) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(16)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_aa_p02
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p11 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_p11(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ detshiftp = dblock%shift
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ deallocate(a)
+ deallocate(s)
+
+ end subroutine hdiag_aa_p11
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p12 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_p12(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_aa_p12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m11 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_m11(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_aa_m11
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m12 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_m12(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_aa_m12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p20 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_p20(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ detshiftp = dblock%shift
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ deallocate(a)
+ deallocate(s)
+
+ end subroutine hdiag_aa_p20
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m20 and integrals aa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_aa_m20(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do l=1, nelact+dblock%nelCAS
+ do k=1, l-1
+ hdiag(detshift+i) = hdiag(detshift+i) &
+ + ijkl(twoint,a(k),a(k),a(l),a(l))
+ if (s(k) .eq. s(l)) then
+ hdiag(detshift + i) = hdiag(detshift+ i) &
+ - ijkl(twoint,a(k),a(l),a(k),a(l))
+ endif
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_aa_m20
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p02 and integrals oo
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oo_p02(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(9) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(9)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(10)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(11)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(12) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(12)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(13) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(13)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(14)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(15)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(16) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(16)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_oo_p02
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p12 and integrals oo
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oo_p12(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_oo_p12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p20 and integrals oo
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oo_p20(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ detshiftp = dblock%shift
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,t1,t1,t2,t2)
+ JK = JK - ijkl(twoint,t1,t2,t1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ deallocate(a)
+ deallocate(s)
+
+ end subroutine hdiag_oo_p20
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p02 and integrals vv
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_vv_p02(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(9) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(9)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(10)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(11)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(12) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(12)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(13) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(13)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(14)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(15)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(16) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(16)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_vv_p02
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m12 and integrals vv
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_vv_m12(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_vv_m12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m20 and integrals vv
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_vv_m20(hdiag, spinref, dblock, o_info, twoint, &
+ nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,p2,p2)
+ JK = JK - ijkl(twoint,p1,p2,p1,p2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_vv_m20
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p01 and integrals ov
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_ov_p01(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_ov_p01
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p02 and integrals ov
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_ov_p02(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ JK = JK - ijkl(twointx,p2,t2,p2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ JK = JK - ijkl(twointx,p2,t2,p2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ JK = JK - ijkl(twointx,p2,t2,p2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ JK = JK - ijkl(twointx,p2,t2,p2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(9) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(9)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(10)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(11)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(12) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(12)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ JK = JK - ijkl(twointx,p2,t2,p2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(13) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(13)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(14)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(15)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(16) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(16)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t2,t2)
+ JK = JK - ijkl(twointx,p2,t2,p2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_ov_p02
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p12 and integrals ov
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_ov_p12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t2,t2)
+ JK = JK - ijkl(twointx,p1,t2,p1,t2)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_ov_p12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m12 and integrals ov
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_ov_m12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p1,p1,t1,t1)
+ JK = JK - ijkl(twointx,p1,t1,p1,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ JK = 0.d0
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ JK = ijkl(twoint,p2,p2,t1,t1)
+ JK = JK - ijkl(twointx,p2,t1,p2,t1)
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_ov_m12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p01 and integrals oa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oa_p01(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_oa_p01
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p02 and integrals oa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oa_p02(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(9) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(9)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(10)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(11)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(12) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(12)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(13) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(13)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(14)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(15)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(16) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(16)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_oa_p02
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p11 and integrals oa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oa_p11(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ detshiftp = dblock%shift
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ deallocate(a)
+ deallocate(s)
+
+ end subroutine hdiag_oa_p11
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p12 and integrals oa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oa_p12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_oa_p12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m12 and integrals oa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oa_m12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_oa_m12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p20 and integrals oa
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_oa_p20(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ detshiftp = dblock%shift
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t1,t1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t1,a(k),t1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),t2,t2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),t2,a(k),t2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ deallocate(a)
+ deallocate(s)
+
+ end subroutine hdiag_oa_p20
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p01 and integrals av
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_av_p01(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_av_p01
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p02 and integrals av
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_av_p02(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(9) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(9)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(10)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(11)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(12) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(12)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(13) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(13)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 4)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(14)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(15)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(16) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(16)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_av_p02
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block p12 and integrals av
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_av_p12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1, t2
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ isfth = ngel
+ !up up
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up occup ligodn, ligoup ligodn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !t1dn t2up ligoup occdn
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ do t1 = isfth + 1, isfth + nocc
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+
+ !dn dn
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (dblock%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ enddo
+ enddo
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_av_p12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m11 and integrals av
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_av_m11(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: p1
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP& PRIVATE(p1, a, s, detshift, detshiftp, spinindx), &
+ !$OMP& PRIVATE(idetact, isft, ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(1) +(p1-isftp-1)*dblock%deltashiftp_array(1)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ !$OMP END DO
+
+ !dn
+ !$OMP DO
+ do p1 = isftp + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift +&
+ dblock%shiftspinp_array(2) + (p1-isftp-1)*dblock%deltashiftp_array(2)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ !$OMP END DO
+
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_av_m11
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m12 and integrals av
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_av_m12(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: t1
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblock%deltashifth_array(1)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblock%deltashifth_array(2)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblock%deltashifth_array(3)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblock%deltashifth_array(4)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblock%deltashifth_array(5)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblock%deltashifth_array(6)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ !up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblock%deltashifth_array(7)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 3)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+
+ !dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ detshift = detshiftp + dblock%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblock%deltashifth_array(8)
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 1)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_av_m12
+
+ !$====================================================================
+ !> @brief Add J-K to hdiag for block m20 and integrals av
+ !> @author ER (generated)
+ !> @date June 2018
+ !$====================================================================
+ subroutine hdiag_av_m20(hdiag, spinref, dblock, o_info, twoint, &
+ twointx, nelact, intkind)
+
+ real(kd_dble), dimension(:), allocatable :: hdiag
+ type(spindetact_list), pointer :: spinref
+ type(deter_dblock), pointer :: Dblock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact
+ type(intkind_JK), intent(in) :: intkind
+ type(intblock) :: twoint
+ type(intblock) :: twointx
+
+ integer :: detshift, detshiftp
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, no, ng
+ integer :: sign
+ integer :: isftp, isfth
+ integer :: p1, p2
+ integer, allocatable :: a(:), s(:)
+ integer :: spinindx, idetact, isft, ndetact, i, j, k, l
+ integer(kindact) :: detact
+ real(kd_dble) :: JK
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ no = o_info%nocc + o_info%nligo
+ ng = o_info%ngel
+
+ sign = intkind%sign
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(twoint, hdiag, spinref, dblock ),&
+ !$OMP& SHARED(twointx),&
+ !$OMP& SHARED(nact, nelact, ng, no, ngel, nligo, nocc, nligv, nvirt, isfth, isftp, sign),&
+ !$OMP&PRIVATE(p1,p2,a,s,detshift,detshiftp,spinindx), &
+ !$OMP& PRIVATE(idetact,isft,ndetact,i,j,k,l,detact,JK)
+
+ allocate(a(nelact+dblock%nelCAS))
+ allocate(s(nelact+dblock%nelCAS))
+
+ !up up
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(1) &
+ + (dblock%shiftp_array(p2-isftp) + (p1-isftp-1))*dblock%deltashiftp_array(1)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, -2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn ligvup ligvdn, ligvup virtdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, isftp + nligv
+ detshiftp = dblock%shift + dblock%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblock%deltashiftp_array(2)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !p1up p2dn virtup ligvdn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv
+ do p1 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftp = dblock%shift + dblock%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblock%deltashiftp_array(3)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. 1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 0)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+
+ !dn dn
+ !$OMP DO
+ do p2 = isftp + 1, isftp + nligv + nvirt
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftp = dblock%shift + dblock%shiftspinp_array(4) &
+ + (dblock%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblock%deltashiftp_array(4)
+ detshift = detshiftp
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p1,p1)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p1,a(k),p1)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ !Get the active determinant block for spin
+ spinindx = get_spinCatindx(spinref, 2)
+ isft = spinref%ShiftSpinCat(spinindx)
+ ndetact = spinref%NdetSpinCat(spinindx)
+ do i=1,ndetact
+ JK = 0.d0
+ idetact = isft+i
+ detact = spinref%elms(idetact)
+ call extract_orbindx_from_detact(detact, a, s, no+ng, nact)
+
+ do k=1, nelact+dblock%nelCAS
+ JK = JK + ijkl(twoint,a(k),a(k),p2,p2)
+ if (s(k) .eq. -1) then
+ JK = JK - ijkl(twointx,a(k),p2,a(k),p2)
+ endif
+ enddo
+ Hdiag(detshift + i) = Hdiag(detshift + i) + sign*JK
+ enddo
+ end do
+ end do
+ !$OMP END DO
+ deallocate(a)
+ deallocate(s)
+
+ !$OMP END PARALLEL
+ end subroutine hdiag_av_m20
+
+end module codegen_hdiag
diff --git a/src/gencode/hv_generated.F90 b/src/gencode/hv_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..67c7f2b4f7bbce75a4b5b94aa68aeec2090f3e4b
--- /dev/null
+++ b/src/gencode/hv_generated.F90
@@ -0,0 +1,2215 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module codegen_hv
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ use fock_gen
+ use aaaa_gen
+ use vvaa_gen
+ use vaao_gen
+ use vaaa_gen
+ use aaoo_gen
+ use aaao_gen
+ use vvoo_gen
+ use vvao_gen
+ use vaoo_gen
+ use vava_gen
+ use vvvo_gen
+ use vvva_gen
+ use vvvv_gen
+ use oooo_gen
+ use vovo_gen
+ use aooo_gen
+ use vavo_gen
+ use vooo_gen
+ use aoao_gen
+ use voao_gen
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_gen(VmI, WmI, spinrefI, dblockI, indxI, &
+ VmJ, WmJ, spinrefJ, dblockJ, indxJ, spincase, pmin, pmax, fock, o_info, &
+ nelact, hcase_info, pcase_info, intkind, &
+ twoint, twointx, intcases)
+
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ type(vecMblock), pointer, intent(inout) :: WmI, WmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(in) :: fock
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nelact, indxI, indxJ, spincase, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intkind_H), intent(in) :: intkind
+ type(intblock), intent(in) :: twoint, twointx
+ type(intcase_list), intent(in) :: intcases
+
+ select case (intkind%name)
+ case ('fock')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (0)
+ call hv_blocs_fock_000_000(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (1)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_000_p011(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_000_p012(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (11)
+ call hv_blocs_fock_000_p11(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_000_m111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_000_m112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ end select
+ case (1)
+ select case (DblockJ%name)
+ case (1)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p01_p011(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p01_p012(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p01_p021(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p01_p022(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_p01_p023(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_p01_p024(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p01_p111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p01_p112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p01_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p01_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p01_m111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p01_m112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p01_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p01_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_p01_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_p01_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p02_p021(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p02_p022(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_p02_p023(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_p02_p024(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p02_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p02_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_p02_p123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_p02_p124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p02_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p02_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_p02_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_p02_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ case (11)
+ call hv_blocs_fock_p11_p11(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p11_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p11_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (20)
+ call hv_blocs_fock_p11_p20(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p12_p121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p12_p122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_p12_p201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_p12_p202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_m11_m111(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_m11_m112(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_m11_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_m11_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_m11_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_m11_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_m11_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_m11_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_m11_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_m11_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_m12_m121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_m12_m122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_m12_m123(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_m12_m124(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_m12_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_m12_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_m12_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_m12_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ end select
+ case (20)
+ select case (DblockJ%name)
+ case (20)
+ call hv_blocs_fock_p20_p20(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_fock_m20_m201(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (2)
+ call hv_blocs_fock_m20_m202(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (3)
+ call hv_blocs_fock_m20_m203(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ case (4)
+ call hv_blocs_fock_m20_m204(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, pmin, pmax, fock)
+ end select
+ end select
+ end select
+ case ('aaaa')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (0)
+ call hv_blocs_aaaa_000_000(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (1)
+ select case (DblockJ%name)
+ case (1)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaaa_p01_p011(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaaa_p01_p012(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaaa_p02_p021(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaaa_p02_p022(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aaaa_p02_p023(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aaaa_p02_p024(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ case (11)
+ call hv_blocs_aaaa_p11_p11(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaaa_p12_p121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaaa_p12_p122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaaa_m11_m111(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaaa_m11_m112(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaaa_m12_m121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaaa_m12_m122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aaaa_m12_m123(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aaaa_m12_m124(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (20)
+ select case (DblockJ%name)
+ case (20)
+ call hv_blocs_aaaa_p20_p20(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaaa_m20_m201(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaaa_m20_m202(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aaaa_m20_m203(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aaaa_m20_m204(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ end select
+ case ('aaao')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (11)
+ call hv_blocs_aaao_000_p11(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (1)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaao_p01_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaao_p01_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaao_p01_m111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaao_p01_m112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaao_p02_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaao_p02_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aaao_p02_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aaao_p02_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ case (20)
+ call hv_blocs_aaao_p11_p20(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (12)
+ select case (DblockJ%name)
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaao_m12_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaao_m12_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aaao_m12_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aaao_m12_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (20)
+ select case (DblockJ%name)
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vaaa')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaaa_000_m111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaaa_000_m112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (1)
+ select case (DblockJ%name)
+ case (11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaaa_p01_p111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaaa_p01_p112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaaa_p01_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaaa_p01_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaaa_p01_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaaa_p01_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaaa_p02_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaaa_p02_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaaa_p02_p123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaaa_p02_p124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaaa_p12_p201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaaa_p12_p202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaaa_m11_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaaa_m11_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaaa_m11_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaaa_m11_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ end select
+ case (20)
+ select case (DblockJ%name)
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('aaoo')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (1)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaoo_p01_p011(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaoo_p01_p012(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaoo_p02_p021(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaoo_p02_p022(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aaoo_p02_p023(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aaoo_p02_p024(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ case (11)
+ call hv_blocs_aaoo_p11_p11(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaoo_p12_p121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaoo_p12_p122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aaoo_m12_m121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aaoo_m12_m122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aaoo_m12_m123(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aaoo_m12_m124(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (20)
+ select case (DblockJ%name)
+ case (20)
+ call hv_blocs_aaoo_p20_p20(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case ('vaao')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (1)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaao_000_p011(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaao_000_p012(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (1)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaao_p01_p021(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaao_p01_p022(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaao_p01_p023(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaao_p01_p024(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaao_p01_p201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaao_p01_p202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaao_p01_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaao_p01_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaao_p01_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaao_p01_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ end select
+ case (11)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaao_p11_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaao_p11_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaao_p11_m111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaao_p11_m112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaao_p12_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaao_p12_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaao_p12_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaao_p12_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaao_m11_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaao_m11_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaao_m11_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaao_m11_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ end select
+ case (20)
+ select case (DblockJ%name)
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vvaa')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (1)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvaa_p01_p011(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvaa_p01_p012(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvaa_p02_p021(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvaa_p02_p022(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvaa_p02_p023(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvaa_p02_p024(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvaa_p12_p121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvaa_p12_p122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvaa_m11_m111(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvaa_m11_m112(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvaa_m12_m121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvaa_m12_m122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvaa_m12_m123(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvaa_m12_m124(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvaa_m20_m201(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvaa_m20_m202(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvaa_m20_m203(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvaa_m20_m204(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ end select
+ case ('vaoo')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaoo_p01_p111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaoo_p01_p112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaoo_p01_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaoo_p01_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaoo_p01_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaoo_p01_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaoo_p02_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaoo_p02_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vaoo_p02_p123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vaoo_p02_p124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vaoo_p12_p201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vaoo_p12_p202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ end select
+ case (20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vvao')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvao_p01_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvao_p01_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvao_p01_m111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvao_p01_m112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvao_p02_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvao_p02_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvao_p02_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvao_p02_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvao_m12_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvao_m12_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvao_m12_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvao_m12_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vvoo')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (1)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvoo_p01_p011(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvoo_p01_p012(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvoo_p02_p021(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvoo_p02_p022(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvoo_p02_p023(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvoo_p02_p024(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvoo_p12_p121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvoo_p12_p122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvoo_m12_m121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvoo_m12_m122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvoo_m12_m123(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvoo_m12_m124(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ end select
+ case ('vava')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vava_000_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vava_000_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vava_000_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vava_000_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vava_p02_p201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vava_p02_p202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vava_p02_p203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vava_p02_p204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vava_p11_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vava_p11_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vava_p11_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vava_p11_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ end select
+ case (20)
+ select case (DblockJ%name)
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vvvo')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvvo_p01_p021(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvvo_p01_p022(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvvo_p01_p023(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvvo_p01_p024(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvvo_m11_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvvo_m11_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvvo_m11_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvvo_m11_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vvva')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvva_p01_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvva_p01_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvva_p01_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvva_p01_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvva_p02_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvva_p02_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvva_p02_p123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvva_p02_p124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvva_m11_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvva_m11_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvva_m11_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvva_m11_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vvvv')
+ select case (DblockI%name)
+ case (2)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvvv_p02_p021(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvvv_p02_p022(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvvv_p02_p023(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvvv_p02_p024(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvvv_m12_m121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvvv_m12_m122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvvv_m12_m123(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvvv_m12_m124(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vvvv_m20_m201(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vvvv_m20_m202(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vvvv_m20_m203(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vvvv_m20_m204(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ end select
+ case ('oooo')
+ select case (DblockI%name)
+ case (2)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_oooo_p02_p021(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_oooo_p02_p022(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_oooo_p02_p023(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_oooo_p02_p024(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_oooo_p12_p121(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_oooo_p12_p122(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (20)
+ select case (DblockJ%name)
+ case (20)
+ call hv_blocs_oooo_p20_p20(VmI, spinrefI, dblockI, &
+ WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case ('vovo')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vovo_000_p021(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vovo_000_p022(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vovo_000_p023(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vovo_000_p024(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('aooo')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aooo_p01_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aooo_p01_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aooo_p02_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aooo_p02_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aooo_p02_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aooo_p02_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ case (20)
+ call hv_blocs_aooo_p11_p20(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (12)
+ select case (DblockJ%name)
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ end select
+ case (20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vavo')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (-12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vavo_000_m121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vavo_000_m122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vavo_000_m123(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vavo_000_m124(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vavo_p02_p111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vavo_p02_p112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vavo_p02_p113(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vavo_p02_p114(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (11)
+ select case (DblockJ%name)
+ end select
+ case (-12)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('vooo')
+ select case (DblockI%name)
+ case (1)
+ select case (DblockJ%name)
+ case (2)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vooo_p01_p021(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vooo_p01_p022(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_vooo_p01_p023(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_vooo_p01_p024(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ end select
+ case (11)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_vooo_p11_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_vooo_p11_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('aoao')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (20)
+ call hv_blocs_aoao_000_p20(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (-20)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aoao_p02_m201(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aoao_p02_m202(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_aoao_p02_m203(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_aoao_p02_m204(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_aoao_p12_m111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_aoao_p12_m112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ end select
+ case (20)
+ select case (DblockJ%name)
+ end select
+ case (-20)
+ select case (DblockJ%name)
+ end select
+ end select
+ case ('voao')
+ select case (DblockI%name)
+ case (0)
+ select case (DblockJ%name)
+ case (12)
+ select case (spincase)
+ case (1)
+ call hv_blocs_voao_000_p121(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_voao_000_p122(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (2)
+ select case (DblockJ%name)
+ case (-11)
+ select case (spincase)
+ case (1)
+ call hv_blocs_voao_p02_m111(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (2)
+ call hv_blocs_voao_p02_m112(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (3)
+ call hv_blocs_voao_p02_m113(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ case (4)
+ call hv_blocs_voao_p02_m114(VmI, VmJ, spinrefI, dblockI, &
+ WmI%elms, WmJ%elms, WmJ%nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ end select
+ end select
+ case (12)
+ select case (DblockJ%name)
+ end select
+ case (-11)
+ select case (DblockJ%name)
+ end select
+ end select
+ end select
+
+ end subroutine hv_blocs_gen
+
+end module codegen_hv
diff --git a/src/gencode/oooo_generated.F90 b/src/gencode/oooo_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4b2bca1ce1cec908983d9601c781441bbcbb7fff
--- /dev/null
+++ b/src/gencode/oooo_generated.F90
@@ -0,0 +1,47 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module oooo_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use oooo_p02_p02_gen1
+ use oooo_p02_p02_gen2
+ use oooo_p02_p02_gen3
+ use oooo_p02_p02_gen4
+ use oooo_p12_p12_gen1
+ use oooo_p12_p12_gen2
+ use oooo_p20_p20_gen
+end module oooo_gen
diff --git a/src/gencode/oooo_p02_p02_generated1.F90 b/src/gencode/oooo_p02_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..67b363638f198914693a08a619e4f3b84bfbdb29
--- /dev/null
+++ b/src/gencode/oooo_p02_p02_generated1.F90
@@ -0,0 +1,1584 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module oooo_p02_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_oooo_p02_p021( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_oooo_p02_p021
+
+end module oooo_p02_p02_gen1
diff --git a/src/gencode/oooo_p02_p02_generated2.F90 b/src/gencode/oooo_p02_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6670f8eb0f7b34b9b7aaee6af51dec9c083b494e
--- /dev/null
+++ b/src/gencode/oooo_p02_p02_generated2.F90
@@ -0,0 +1,2941 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module oooo_p02_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_oooo_p02_p022( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_oooo_p02_p022
+
+end module oooo_p02_p02_gen2
diff --git a/src/gencode/oooo_p02_p02_generated3.F90 b/src/gencode/oooo_p02_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4dfad3d11263c7f645bb3c9ab14c3b78779aba05
--- /dev/null
+++ b/src/gencode/oooo_p02_p02_generated3.F90
@@ -0,0 +1,2941 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module oooo_p02_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_oooo_p02_p023( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_oooo_p02_p023
+
+end module oooo_p02_p02_gen3
diff --git a/src/gencode/oooo_p02_p02_generated4.F90 b/src/gencode/oooo_p02_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..410cce48afa78c8c03114d5d0c824a60ed92caab
--- /dev/null
+++ b/src/gencode/oooo_p02_p02_generated4.F90
@@ -0,0 +1,1579 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module oooo_p02_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_oooo_p02_p024( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(13) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(13)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(14) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(14)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(15) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(15)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !Case p3 in virtU and p4 in ligvD
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ p4 = p2
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(16) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(16)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_oooo_p02_p024
+
+end module oooo_p02_p02_gen4
diff --git a/src/gencode/oooo_p12_p12_generated1.F90 b/src/gencode/oooo_p12_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e9741ccabd187fb40e56878ef78527d0aa8b3907
--- /dev/null
+++ b/src/gencode/oooo_p12_p12_generated1.F90
@@ -0,0 +1,1535 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module oooo_p12_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_oooo_p12_p121( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_oooo_p12_p121
+
+end module oooo_p12_p12_gen1
diff --git a/src/gencode/oooo_p12_p12_generated2.F90 b/src/gencode/oooo_p12_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b023887b2623d4c15e49fc4a66488894725347ba
--- /dev/null
+++ b/src/gencode/oooo_p12_p12_generated2.F90
@@ -0,0 +1,1533 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module oooo_p12_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_oooo_p12_p122( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 dn
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_oooo_p12_p122
+
+end module oooo_p12_p12_gen2
diff --git a/src/gencode/oooo_p20_p20_generated.F90 b/src/gencode/oooo_p20_p20_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..eebebe2fbe164079667439a45e9dd9b7a11d7d2b
--- /dev/null
+++ b/src/gencode/oooo_p20_p20_generated.F90
@@ -0,0 +1,1506 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module oooo_p20_p20_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_oooo_p20_p20( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !spinpI = 0
+ !$OMP PARALLEL &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot) &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t2 < t3 < t1
+ do t4 = isfth+nocc+1, t2-1
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(1)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 < t2 < t1
+ do t3 = max(t4+1,isfth+nocc+1), t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(15), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t4 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif !t2
+ !t4 < t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(17), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t1 ,t1 ,t2 ,t4 )&
+ +&
+ ijkl2(twoint,t1 ,t2 ,t1 ,t4 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !t4 < t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(19), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,t1 ,t3 ,t2 ,t4 )&
+ -&
+ ijkl2(twoint,t1 ,t4 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,t2 ,t2 ,t1 ,t3 )&
+ +&
+ ijkl2(twoint,t2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_oooo_p20_p20
+
+end module oooo_p20_p20_gen
diff --git a/src/gencode/vaaa_000_m11_generated1.F90 b/src/gencode/vaaa_000_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..37893bebb50cd0c9d05c9fcef69654e003a0eba0
--- /dev/null
+++ b/src/gencode/vaaa_000_m11_generated1.F90
@@ -0,0 +1,218 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_000_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_000_m111( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaaa_000_m111
+
+end module vaaa_000_m11_gen1
diff --git a/src/gencode/vaaa_000_m11_generated2.F90 b/src/gencode/vaaa_000_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f12350d5713c8c231953360c5b39246c782060bf
--- /dev/null
+++ b/src/gencode/vaaa_000_m11_generated2.F90
@@ -0,0 +1,216 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_000_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_000_m112( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaaa_000_m112
+
+end module vaaa_000_m11_gen2
diff --git a/src/gencode/vaaa_generated.F90 b/src/gencode/vaaa_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..78e7056ae903570c6088563e292f32526ff30ef8
--- /dev/null
+++ b/src/gencode/vaaa_generated.F90
@@ -0,0 +1,58 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use vaaa_000_m11_gen1
+ use vaaa_000_m11_gen2
+ use vaaa_p01_p11_gen1
+ use vaaa_p01_p11_gen2
+ use vaaa_p01_m12_gen1
+ use vaaa_p01_m12_gen2
+ use vaaa_p01_m12_gen3
+ use vaaa_p01_m12_gen4
+ use vaaa_p02_p12_gen1
+ use vaaa_p02_p12_gen2
+ use vaaa_p02_p12_gen3
+ use vaaa_p02_p12_gen4
+ use vaaa_p12_p20_gen1
+ use vaaa_p12_p20_gen2
+ use vaaa_m11_m20_gen1
+ use vaaa_m11_m20_gen2
+ use vaaa_m11_m20_gen3
+ use vaaa_m11_m20_gen4
+end module vaaa_gen
diff --git a/src/gencode/vaaa_m11_m20_generated1.F90 b/src/gencode/vaaa_m11_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3e4c1072409f61150cce86fe6dfac0ce91bd8586
--- /dev/null
+++ b/src/gencode/vaaa_m11_m20_generated1.F90
@@ -0,0 +1,315 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_m11_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_m11_m201( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ detshiftI = detshiftpI
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_m11_m201
+
+end module vaaa_m11_m20_gen1
diff --git a/src/gencode/vaaa_m11_m20_generated2.F90 b/src/gencode/vaaa_m11_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..40d74d4f0c71f625186c26a4ae463169d666a4c4
--- /dev/null
+++ b/src/gencode/vaaa_m11_m20_generated2.F90
@@ -0,0 +1,315 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_m11_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_m11_m202( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_m11_m202
+
+end module vaaa_m11_m20_gen2
diff --git a/src/gencode/vaaa_m11_m20_generated3.F90 b/src/gencode/vaaa_m11_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..de493fcdf8634bb17b30aed33eb6e0257ba8a29d
--- /dev/null
+++ b/src/gencode/vaaa_m11_m20_generated3.F90
@@ -0,0 +1,315 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_m11_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_m11_m203( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_m11_m203
+
+end module vaaa_m11_m20_gen3
diff --git a/src/gencode/vaaa_m11_m20_generated4.F90 b/src/gencode/vaaa_m11_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fb1f847c8fc9842311070c9ef7f5b9a314aa10bb
--- /dev/null
+++ b/src/gencode/vaaa_m11_m20_generated4.F90
@@ -0,0 +1,314 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_m11_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_m11_m204( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_m11_m204
+
+end module vaaa_m11_m20_gen4
diff --git a/src/gencode/vaaa_p01_m12_generated1.F90 b/src/gencode/vaaa_p01_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..44f2b233e711b61a4836efc8e9131aff323590d1
--- /dev/null
+++ b/src/gencode/vaaa_p01_m12_generated1.F90
@@ -0,0 +1,545 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p01_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p01_m121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_p01_m121
+
+end module vaaa_p01_m12_gen1
diff --git a/src/gencode/vaaa_p01_m12_generated2.F90 b/src/gencode/vaaa_p01_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f16d4e231c073d9d84a9a87d3bc32e9a68041547
--- /dev/null
+++ b/src/gencode/vaaa_p01_m12_generated2.F90
@@ -0,0 +1,545 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p01_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p01_m122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_p01_m122
+
+end module vaaa_p01_m12_gen2
diff --git a/src/gencode/vaaa_p01_m12_generated3.F90 b/src/gencode/vaaa_p01_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2431140d2e268821bb5a75c690ee5f612b2a02cc
--- /dev/null
+++ b/src/gencode/vaaa_p01_m12_generated3.F90
@@ -0,0 +1,545 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p01_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p01_m123( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_p01_m123
+
+end module vaaa_p01_m12_gen3
diff --git a/src/gencode/vaaa_p01_m12_generated4.F90 b/src/gencode/vaaa_p01_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..64cd9e83cfdf81c3e8bbf02e5135b699bc609a8c
--- /dev/null
+++ b/src/gencode/vaaa_p01_m12_generated4.F90
@@ -0,0 +1,544 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p01_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p01_m124( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_p01_m124
+
+end module vaaa_p01_m12_gen4
diff --git a/src/gencode/vaaa_p01_p11_generated1.F90 b/src/gencode/vaaa_p01_p11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3adffa7ff4e4d8a56868d59a5ce7f1fdac0e5418
--- /dev/null
+++ b/src/gencode/vaaa_p01_p11_generated1.F90
@@ -0,0 +1,342 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p01_p11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p01_p111( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaaa_p01_p111
+
+end module vaaa_p01_p11_gen1
diff --git a/src/gencode/vaaa_p01_p11_generated2.F90 b/src/gencode/vaaa_p01_p11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..514d78bd1e60282bf3bdc9f01fbb42ca57bcb388
--- /dev/null
+++ b/src/gencode/vaaa_p01_p11_generated2.F90
@@ -0,0 +1,340 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p01_p11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p01_p112( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaaa_p01_p112
+
+end module vaaa_p01_p11_gen2
diff --git a/src/gencode/vaaa_p02_p12_generated1.F90 b/src/gencode/vaaa_p02_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2445e6d0c7d84a7034079b1366ef35326485c446
--- /dev/null
+++ b/src/gencode/vaaa_p02_p12_generated1.F90
@@ -0,0 +1,1421 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p02_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p02_p121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_p02_p121
+
+end module vaaa_p02_p12_gen1
diff --git a/src/gencode/vaaa_p02_p12_generated2.F90 b/src/gencode/vaaa_p02_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f1e8dc7046371dfb3be8b60f108cd5dd7ce3035b
--- /dev/null
+++ b/src/gencode/vaaa_p02_p12_generated2.F90
@@ -0,0 +1,1421 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p02_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p02_p122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_p02_p122
+
+end module vaaa_p02_p12_gen2
diff --git a/src/gencode/vaaa_p02_p12_generated3.F90 b/src/gencode/vaaa_p02_p12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..55e0ccaeaf3a701bb776bb9cba93df9675383b8e
--- /dev/null
+++ b/src/gencode/vaaa_p02_p12_generated3.F90
@@ -0,0 +1,1421 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p02_p12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p02_p123( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_p02_p123
+
+end module vaaa_p02_p12_gen3
diff --git a/src/gencode/vaaa_p02_p12_generated4.F90 b/src/gencode/vaaa_p02_p12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f491655f6871e75105744b8aaa30d7d3b0f14f9b
--- /dev/null
+++ b/src/gencode/vaaa_p02_p12_generated4.F90
@@ -0,0 +1,1420 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p02_p12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p02_p124( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaaa_p02_p124
+
+end module vaaa_p02_p12_gen4
diff --git a/src/gencode/vaaa_p12_p20_generated1.F90 b/src/gencode/vaaa_p12_p20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..431d649150e07d946a9bce672867252cee9f5189
--- /dev/null
+++ b/src/gencode/vaaa_p12_p20_generated1.F90
@@ -0,0 +1,791 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p12_p20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p12_p201( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaaa_p12_p201
+
+end module vaaa_p12_p20_gen1
diff --git a/src/gencode/vaaa_p12_p20_generated2.F90 b/src/gencode/vaaa_p12_p20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..73e02a1913d5ac355ec02aecb4fecd953690777a
--- /dev/null
+++ b/src/gencode/vaaa_p12_p20_generated2.F90
@@ -0,0 +1,789 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaaa_p12_p20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaaa_p12_p202( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J, andIJ, spinandIJ)
+ do k = 1, Nelact+1
+ JK = JK +ijkl2(twoint,p1 ,diffJ(1),andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),diffJ(1),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffI(1),diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaaa_p12_p202
+
+end module vaaa_p12_p20_gen2
diff --git a/src/gencode/vaao_000_p01_generated1.F90 b/src/gencode/vaao_000_p01_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b11b3d66b4a1ac56c23ba19f26818f8fcc10fee4
--- /dev/null
+++ b/src/gencode/vaao_000_p01_generated1.F90
@@ -0,0 +1,279 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_000_p01_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_000_p011( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaao_000_p011
+
+end module vaao_000_p01_gen1
diff --git a/src/gencode/vaao_000_p01_generated2.F90 b/src/gencode/vaao_000_p01_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..618fb08290f7d05b3317d3d649e39b1dd3a08c11
--- /dev/null
+++ b/src/gencode/vaao_000_p01_generated2.F90
@@ -0,0 +1,277 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_000_p01_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_000_p012( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaao_000_p012
+
+end module vaao_000_p01_gen2
diff --git a/src/gencode/vaao_generated.F90 b/src/gencode/vaao_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1024be7d912dad6e2e4db225d1b96d2d3ea8be6b
--- /dev/null
+++ b/src/gencode/vaao_generated.F90
@@ -0,0 +1,64 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use vaao_000_p01_gen1
+ use vaao_000_p01_gen2
+ use vaao_p01_p02_gen1
+ use vaao_p01_p02_gen2
+ use vaao_p01_p02_gen3
+ use vaao_p01_p02_gen4
+ use vaao_p01_p20_gen1
+ use vaao_p01_p20_gen2
+ use vaao_p01_m20_gen1
+ use vaao_p01_m20_gen2
+ use vaao_p01_m20_gen3
+ use vaao_p01_m20_gen4
+ use vaao_p11_p12_gen1
+ use vaao_p11_p12_gen2
+ use vaao_p11_m11_gen1
+ use vaao_p11_m11_gen2
+ use vaao_p12_m12_gen1
+ use vaao_p12_m12_gen2
+ use vaao_p12_m12_gen3
+ use vaao_p12_m12_gen4
+ use vaao_m11_m12_gen1
+ use vaao_m11_m12_gen2
+ use vaao_m11_m12_gen3
+ use vaao_m11_m12_gen4
+end module vaao_gen
diff --git a/src/gencode/vaao_m11_m12_generated1.F90 b/src/gencode/vaao_m11_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cc51d40550a97da872df93e4040fcd296d22195b
--- /dev/null
+++ b/src/gencode/vaao_m11_m12_generated1.F90
@@ -0,0 +1,421 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_m11_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_m11_m121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_m11_m121
+
+end module vaao_m11_m12_gen1
diff --git a/src/gencode/vaao_m11_m12_generated2.F90 b/src/gencode/vaao_m11_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a3a3d6c3a323ee94f39d1bf2339ccb039d4fbb4e
--- /dev/null
+++ b/src/gencode/vaao_m11_m12_generated2.F90
@@ -0,0 +1,421 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_m11_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_m11_m122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_m11_m122
+
+end module vaao_m11_m12_gen2
diff --git a/src/gencode/vaao_m11_m12_generated3.F90 b/src/gencode/vaao_m11_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bb6aa040adcfeee31160c66c995f7f8f9ae1e146
--- /dev/null
+++ b/src/gencode/vaao_m11_m12_generated3.F90
@@ -0,0 +1,421 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_m11_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_m11_m123( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_m11_m123
+
+end module vaao_m11_m12_gen3
diff --git a/src/gencode/vaao_m11_m12_generated4.F90 b/src/gencode/vaao_m11_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..082bae9bede38f2e7e0e6a24bb9764b301fe3ffe
--- /dev/null
+++ b/src/gencode/vaao_m11_m12_generated4.F90
@@ -0,0 +1,420 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_m11_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_m11_m124( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_m11_m124
+
+end module vaao_m11_m12_gen4
diff --git a/src/gencode/vaao_p01_m20_generated1.F90 b/src/gencode/vaao_p01_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3f45225b25d26b92829f3bf2a1c4e1717fa7b7bb
--- /dev/null
+++ b/src/gencode/vaao_p01_m20_generated1.F90
@@ -0,0 +1,345 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_m201( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ detshiftI = detshiftpI
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p01_m201
+
+end module vaao_p01_m20_gen1
diff --git a/src/gencode/vaao_p01_m20_generated2.F90 b/src/gencode/vaao_p01_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..854af372e2d349c915042f951bff8763df785e3e
--- /dev/null
+++ b/src/gencode/vaao_p01_m20_generated2.F90
@@ -0,0 +1,345 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_m202( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p01_m202
+
+end module vaao_p01_m20_gen2
diff --git a/src/gencode/vaao_p01_m20_generated3.F90 b/src/gencode/vaao_p01_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f105bf11545da9e4fed7c1d80755bb03dcb290f3
--- /dev/null
+++ b/src/gencode/vaao_p01_m20_generated3.F90
@@ -0,0 +1,345 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_m203( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p01_m203
+
+end module vaao_p01_m20_gen3
diff --git a/src/gencode/vaao_p01_m20_generated4.F90 b/src/gencode/vaao_p01_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8461cdda04ab70336c8f3d6871334db881cba1ec
--- /dev/null
+++ b/src/gencode/vaao_p01_m20_generated4.F90
@@ -0,0 +1,344 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_m204( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p01_m204
+
+end module vaao_p01_m20_gen4
diff --git a/src/gencode/vaao_p01_p02_generated1.F90 b/src/gencode/vaao_p01_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fecb45fe1d6b0bbdbae660f72744d1db5e9e8241
--- /dev/null
+++ b/src/gencode/vaao_p01_p02_generated1.F90
@@ -0,0 +1,1275 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_p021( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p2 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p2 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p2 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p01_p021
+
+end module vaao_p01_p02_gen1
diff --git a/src/gencode/vaao_p01_p02_generated2.F90 b/src/gencode/vaao_p01_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9b6a4362b652ac61025f3db9584e7e97decb3a6f
--- /dev/null
+++ b/src/gencode/vaao_p01_p02_generated2.F90
@@ -0,0 +1,1275 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_p022( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p2 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p01_p022
+
+end module vaao_p01_p02_gen2
diff --git a/src/gencode/vaao_p01_p02_generated3.F90 b/src/gencode/vaao_p01_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..63bf5dc0046b1de02d021963fbf8a6e00b6dc9bc
--- /dev/null
+++ b/src/gencode/vaao_p01_p02_generated3.F90
@@ -0,0 +1,1275 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_p023( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p2 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p01_p023
+
+end module vaao_p01_p02_gen3
diff --git a/src/gencode/vaao_p01_p02_generated4.F90 b/src/gencode/vaao_p01_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0956cf7d4a866f28219b0a4a09f0d3b57e549d52
--- /dev/null
+++ b/src/gencode/vaao_p01_p02_generated4.F90
@@ -0,0 +1,1274 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_p024( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p2 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p2 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p2 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p01_p024
+
+end module vaao_p01_p02_gen4
diff --git a/src/gencode/vaao_p01_p20_generated1.F90 b/src/gencode/vaao_p01_p20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..740161345818d799102655495709975caad689db
--- /dev/null
+++ b/src/gencode/vaao_p01_p20_generated1.F90
@@ -0,0 +1,579 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_p20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_p201( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaao_p01_p201
+
+end module vaao_p01_p20_gen1
diff --git a/src/gencode/vaao_p01_p20_generated2.F90 b/src/gencode/vaao_p01_p20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8216340b19438a5bd3d7a52ae12d16cab987b631
--- /dev/null
+++ b/src/gencode/vaao_p01_p20_generated2.F90
@@ -0,0 +1,577 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p01_p20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p01_p202( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaao_p01_p202
+
+end module vaao_p01_p20_gen2
diff --git a/src/gencode/vaao_p11_m11_generated1.F90 b/src/gencode/vaao_p11_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..95262afe1cd10f133941e73284b2de80ccaf13e7
--- /dev/null
+++ b/src/gencode/vaao_p11_m11_generated1.F90
@@ -0,0 +1,234 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p11_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p11_m111( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaao_p11_m111
+
+end module vaao_p11_m11_gen1
diff --git a/src/gencode/vaao_p11_m11_generated2.F90 b/src/gencode/vaao_p11_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..23f2a95c9ecf49b4da43a855fa358667c00ed30f
--- /dev/null
+++ b/src/gencode/vaao_p11_m11_generated2.F90
@@ -0,0 +1,232 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p11_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p11_m112( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = 1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ do t3 = isfth + 1, isfth+nocc+nligo
+ !spint3 = -1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(2), &
+ 0 ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaao_p11_m112
+
+end module vaao_p11_m11_gen2
diff --git a/src/gencode/vaao_p11_p12_generated1.F90 b/src/gencode/vaao_p11_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..7a77a0bc490734c87ae42801ce62068947295724
--- /dev/null
+++ b/src/gencode/vaao_p11_p12_generated1.F90
@@ -0,0 +1,724 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p11_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p11_p121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK -delta(1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaao_p11_p121
+
+end module vaao_p11_p12_gen1
diff --git a/src/gencode/vaao_p11_p12_generated2.F90 b/src/gencode/vaao_p11_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..25ee2644ff0fd56a85ab89fd56ba9d9ac0463893
--- /dev/null
+++ b/src/gencode/vaao_p11_p12_generated2.F90
@@ -0,0 +1,722 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p11_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p11_p122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t1 )&
+ +ijkl2(twointx,p1 ,t1 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact+1))
+ allocate(spinandIJ(Nelact+1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact+1
+ JK = JK -delta(-1,spinandIJ(k))*&
+ ijkl2(twoint,p1 ,andIJ(k),andIJ(k),t2 )&
+ +ijkl2(twointx,p1 ,t2 ,andIJ(k),andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffI(1),t2 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaao_p11_p122
+
+end module vaao_p11_p12_gen2
diff --git a/src/gencode/vaao_p12_m12_generated1.F90 b/src/gencode/vaao_p12_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..185e8c332b377bb2ff2e227bad925ed89d1d31cf
--- /dev/null
+++ b/src/gencode/vaao_p12_m12_generated1.F90
@@ -0,0 +1,1019 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p12_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p12_m121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p12_m121
+
+end module vaao_p12_m12_gen1
diff --git a/src/gencode/vaao_p12_m12_generated2.F90 b/src/gencode/vaao_p12_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b9811257ec7aa45dddf1a562c6f6b15a136f158e
--- /dev/null
+++ b/src/gencode/vaao_p12_m12_generated2.F90
@@ -0,0 +1,1019 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p12_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p12_m122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p12_m122
+
+end module vaao_p12_m12_gen2
diff --git a/src/gencode/vaao_p12_m12_generated3.F90 b/src/gencode/vaao_p12_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..20165b7ddf79659342838f370d2347d332be26c0
--- /dev/null
+++ b/src/gencode/vaao_p12_m12_generated3.F90
@@ -0,0 +1,1019 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p12_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p12_m123( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p12_m123
+
+end module vaao_p12_m12_gen3
diff --git a/src/gencode/vaao_p12_m12_generated4.F90 b/src/gencode/vaao_p12_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d520b87675460b01054a3846b2b578a91f467ba6
--- /dev/null
+++ b/src/gencode/vaao_p12_m12_generated4.F90
@@ -0,0 +1,1018 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaao_p12_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaao_p12_m124( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !U0UU
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !U0DU
+ !spint3 = -1
+ !spint4 = 1
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t3 in occD t4 in ligoU
+ !*** t4 < t1
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ !*** t4 = t1
+ ! t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1 in ligo
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p2 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !D0DU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth + 1, isfth+nocc+nligo
+ if (t1 .gt. isfth + nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t1 .le. isfth + nocc) then !t1 in occ
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in occ
+ enddo !t4
+ !D0DD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t1
+ do t4 = isfth + 1, t1-1
+ if (t1 .gt. isfth+nocc) then !t1 in ligo
+ ! t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(7), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t4 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1 in ligo
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ ! t4 = t1 < t3
+ do t3 = max(t1+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(10), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),diffJ(2),t3 )&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaao_p12_m124
+
+end module vaao_p12_m12_gen4
diff --git a/src/gencode/vaoo_generated.F90 b/src/gencode/vaoo_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0d31a5bbb0945c4466bc6c33ec93210b39671307
--- /dev/null
+++ b/src/gencode/vaoo_generated.F90
@@ -0,0 +1,52 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use vaoo_p01_p11_gen1
+ use vaoo_p01_p11_gen2
+ use vaoo_p01_m12_gen1
+ use vaoo_p01_m12_gen2
+ use vaoo_p01_m12_gen3
+ use vaoo_p01_m12_gen4
+ use vaoo_p02_p12_gen1
+ use vaoo_p02_p12_gen2
+ use vaoo_p02_p12_gen3
+ use vaoo_p02_p12_gen4
+ use vaoo_p12_p20_gen1
+ use vaoo_p12_p20_gen2
+end module vaoo_gen
diff --git a/src/gencode/vaoo_p01_m12_generated1.F90 b/src/gencode/vaoo_p01_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..875cc27ef7e8fbccf37d07fc720821e3c80c9d3f
--- /dev/null
+++ b/src/gencode/vaoo_p01_m12_generated1.F90
@@ -0,0 +1,923 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p01_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p01_m121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaoo_p01_m121
+
+end module vaoo_p01_m12_gen1
diff --git a/src/gencode/vaoo_p01_m12_generated2.F90 b/src/gencode/vaoo_p01_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..de8b5626f540464d941f9095049fe354f0d82870
--- /dev/null
+++ b/src/gencode/vaoo_p01_m12_generated2.F90
@@ -0,0 +1,923 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p01_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p01_m122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaoo_p01_m122
+
+end module vaoo_p01_m12_gen2
diff --git a/src/gencode/vaoo_p01_m12_generated3.F90 b/src/gencode/vaoo_p01_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..085d28766447fc9ae228212247a59bcfd0552b84
--- /dev/null
+++ b/src/gencode/vaoo_p01_m12_generated3.F90
@@ -0,0 +1,923 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p01_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p01_m123( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaoo_p01_m123
+
+end module vaoo_p01_m12_gen3
diff --git a/src/gencode/vaoo_p01_m12_generated4.F90 b/src/gencode/vaoo_p01_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4ce3faeff85236ed9aaa2f38ee6cb0e6aa3e4a61
--- /dev/null
+++ b/src/gencode/vaoo_p01_m12_generated4.F90
@@ -0,0 +1,922 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p01_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p01_m124( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaoo_p01_m124
+
+end module vaoo_p01_m12_gen4
diff --git a/src/gencode/vaoo_p01_p11_generated1.F90 b/src/gencode/vaoo_p01_p11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..22578a592b429705b42ecd70d45e09fb6c8be714
--- /dev/null
+++ b/src/gencode/vaoo_p01_p11_generated1.F90
@@ -0,0 +1,529 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p01_p11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p01_p111( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,diffJ(1),t3 ,t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,diffJ(1),t3 ,t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,diffJ(1),t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,diffJ(1),t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaoo_p01_p111
+
+end module vaoo_p01_p11_gen1
diff --git a/src/gencode/vaoo_p01_p11_generated2.F90 b/src/gencode/vaoo_p01_p11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c062a1c56bc4e6ffda51e0ecd7b6e0cf6bf5976b
--- /dev/null
+++ b/src/gencode/vaoo_p01_p11_generated2.F90
@@ -0,0 +1,527 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p01_p11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p01_p112( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 < t1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,diffJ(1),t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,diffJ(1),t3 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 dn
+ !spint3 = -1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ t1-ngel ,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ do t3 = isfth + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !dn t3 < t1
+ !spint3 = -1
+ do t3 = isfth + 1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(5), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,diffJ(1),t3 ,t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 > t1
+ do t3 = t1 + 1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(11), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,diffJ(1),t3 ,t1 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaoo_p01_p112
+
+end module vaoo_p01_p11_gen2
diff --git a/src/gencode/vaoo_p02_p12_generated1.F90 b/src/gencode/vaoo_p02_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..30b3d4da7077af37385c35a10e3a7ddc8a0d5632
--- /dev/null
+++ b/src/gencode/vaoo_p02_p12_generated1.F90
@@ -0,0 +1,6023 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p02_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p02_p121( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaoo_p02_p121
+
+end module vaoo_p02_p12_gen1
diff --git a/src/gencode/vaoo_p02_p12_generated2.F90 b/src/gencode/vaoo_p02_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ab7ec8cb2213b59dff6ed8a58d73c7c509430920
--- /dev/null
+++ b/src/gencode/vaoo_p02_p12_generated2.F90
@@ -0,0 +1,6033 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p02_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p02_p122( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaoo_p02_p122
+
+end module vaoo_p02_p12_gen2
diff --git a/src/gencode/vaoo_p02_p12_generated3.F90 b/src/gencode/vaoo_p02_p12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1f53496c8b39874b3eb91c50ca4451786c8ef511
--- /dev/null
+++ b/src/gencode/vaoo_p02_p12_generated3.F90
@@ -0,0 +1,6033 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p02_p12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p02_p123( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaoo_p02_p123
+
+end module vaoo_p02_p12_gen3
diff --git a/src/gencode/vaoo_p02_p12_generated4.F90 b/src/gencode/vaoo_p02_p12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1ca406e0ed02fd281502b797d1fd81629ef91084
--- /dev/null
+++ b/src/gencode/vaoo_p02_p12_generated4.F90
@@ -0,0 +1,6042 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p02_p12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p02_p124( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p2 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p2 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p2 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vaoo_p02_p124
+
+end module vaoo_p02_p12_gen4
diff --git a/src/gencode/vaoo_p12_p20_generated1.F90 b/src/gencode/vaoo_p12_p20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c30ab0e1d7f0a861936bcb3eeb3fd1aa419bdcc3
--- /dev/null
+++ b/src/gencode/vaoo_p12_p20_generated1.F90
@@ -0,0 +1,3110 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p12_p20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p12_p201( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaoo_p12_p201
+
+end module vaoo_p12_p20_gen1
diff --git a/src/gencode/vaoo_p12_p20_generated2.F90 b/src/gencode/vaoo_p12_p20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..61d5700b54f0b0983545f50cdae7f562b7105daf
--- /dev/null
+++ b/src/gencode/vaoo_p12_p20_generated2.F90
@@ -0,0 +1,3118 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vaoo_p12_p20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vaoo_p12_p202( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t1
+ !t2 < t1 < t4 < t3
+ do t4 = t1+1, isfth+nocc+nligo
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+ !Not possible - add the shift
+ enddo !t3
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t1 < t3
+ t4 = t2
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ !*** t4 = t1
+ !t2 < t4 < t1 < t3
+ t4 = t1
+ do t3 = isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ t1-ngel ,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ !t4 < t3 < t2 < t1
+ do t4 = isfth+1, t2-1
+ if ( t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2 in ligo
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else ! t1 in occ
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+nocc+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 < t2
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !*** t4 = t2
+ !t4 = t2 < t3 < t1
+ t4 = t2
+ do t3 =isfth+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t2 in ligo
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t1 < t3
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 < t2
+ do t4 = isfth+nocc+1, t2-1
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 =isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t4 > t2
+ do t4 = t2+1, isfth+nocc+nligo
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ !*** t4 < t1
+ do t4 = isfth+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ else !t1 in occ
+ !*** t4 = t1
+ !t2 < t4 = t1 < t3
+ t4 = t1
+ do t3 = isfth+nocc+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ do t4 = isfth+1, isfth+nocc+nligo
+ if (t2 .gt. isfth+nocc) then!t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !t3 in occD t4 in ligoU
+ do t4 = isfth+nocc+1, isfth+nocc+nligo
+ if (t2 .le. isfth+nocc) then !t2 in occ
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ enddo !t4
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 < t2
+ do t4 = isfth+1, t2-1
+ if (t2 .gt. isfth+nocc) then !t2 in ligo
+ !t4 < t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(16), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t2
+ !t4 < t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(18), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 < t1
+ do t3 = max(t2+1,isfth+nocc+1), t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(21), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t1 )&
+ +&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t1 )
+ JK = JK -delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t2 )&
+ +&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t4 = t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(23), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t1 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t1 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ !*** t2 < t4 < t1
+ do t4 = t2+1, t1-1
+ !t2 < t4 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(26), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t4 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t4 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t4
+ !*** t4 = t1
+ t4 = t1
+ !t2 < t4 = t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(29), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),t2 ,t3 )&
+ -&
+ ijkl2(twointx,p1 ,t2 ,diffJ(1),t3 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vaoo_p12_p202
+
+end module vaoo_p12_p20_gen2
diff --git a/src/gencode/vava_000_m20_generated1.F90 b/src/gencode/vava_000_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3ba8d71f54494df0d4632e14a3b36463cabb2aa2
--- /dev/null
+++ b/src/gencode/vava_000_m20_generated1.F90
@@ -0,0 +1,184 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_000_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_000_m201( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ detshiftI = detshiftpI
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_000_m201
+
+end module vava_000_m20_gen1
diff --git a/src/gencode/vava_000_m20_generated2.F90 b/src/gencode/vava_000_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..7a172ce3e9c91af1964d113106dd15d9d4056bca
--- /dev/null
+++ b/src/gencode/vava_000_m20_generated2.F90
@@ -0,0 +1,184 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_000_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_000_m202( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_000_m202
+
+end module vava_000_m20_gen2
diff --git a/src/gencode/vava_000_m20_generated3.F90 b/src/gencode/vava_000_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..00640543fac26a34ec8d7d28999a0485ae154625
--- /dev/null
+++ b/src/gencode/vava_000_m20_generated3.F90
@@ -0,0 +1,184 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_000_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_000_m203( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_000_m203
+
+end module vava_000_m20_gen3
diff --git a/src/gencode/vava_000_m20_generated4.F90 b/src/gencode/vava_000_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..49ffe155cb474c4ac48f1dd8e8d35b5a02b5ece2
--- /dev/null
+++ b/src/gencode/vava_000_m20_generated4.F90
@@ -0,0 +1,183 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_000_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_000_m204( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_000_m204
+
+end module vava_000_m20_gen4
diff --git a/src/gencode/vava_generated.F90 b/src/gencode/vava_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2ea4d296402edb90bc14eec74be34b1fa00200ab
--- /dev/null
+++ b/src/gencode/vava_generated.F90
@@ -0,0 +1,52 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use vava_000_m20_gen1
+ use vava_000_m20_gen2
+ use vava_000_m20_gen3
+ use vava_000_m20_gen4
+ use vava_p02_p20_gen1
+ use vava_p02_p20_gen2
+ use vava_p02_p20_gen3
+ use vava_p02_p20_gen4
+ use vava_p11_m12_gen1
+ use vava_p11_m12_gen2
+ use vava_p11_m12_gen3
+ use vava_p11_m12_gen4
+end module vava_gen
diff --git a/src/gencode/vava_p02_p20_generated1.F90 b/src/gencode/vava_p02_p20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..100fd40534f383d0b41d59e8b9c13890eaf42e2d
--- /dev/null
+++ b/src/gencode/vava_p02_p20_generated1.F90
@@ -0,0 +1,562 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_p02_p20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_p02_p201( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_p02_p201
+
+end module vava_p02_p20_gen1
diff --git a/src/gencode/vava_p02_p20_generated2.F90 b/src/gencode/vava_p02_p20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4cfef64122f16c44e84df0d747f0998c15b5414c
--- /dev/null
+++ b/src/gencode/vava_p02_p20_generated2.F90
@@ -0,0 +1,562 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_p02_p20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_p02_p202( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_p02_p202
+
+end module vava_p02_p20_gen2
diff --git a/src/gencode/vava_p02_p20_generated3.F90 b/src/gencode/vava_p02_p20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cb0d6b2a45b0dcdbf8b1c4ef358792ffe833bfc1
--- /dev/null
+++ b/src/gencode/vava_p02_p20_generated3.F90
@@ -0,0 +1,562 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_p02_p20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_p02_p203( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_p02_p203
+
+end module vava_p02_p20_gen3
diff --git a/src/gencode/vava_p02_p20_generated4.F90 b/src/gencode/vava_p02_p20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3d982b64aaa1aaea3d8f8bc3d7110db7024a09f1
--- /dev/null
+++ b/src/gencode/vava_p02_p20_generated4.F90
@@ -0,0 +1,561 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_p02_p20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_p02_p204( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_p02_p204
+
+end module vava_p02_p20_gen4
diff --git a/src/gencode/vava_p11_m12_generated1.F90 b/src/gencode/vava_p11_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6b4478e7e13ca80e92686d03ea8afdf2fb40998e
--- /dev/null
+++ b/src/gencode/vava_p11_m12_generated1.F90
@@ -0,0 +1,269 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_p11_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_p11_m121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_p11_m121
+
+end module vava_p11_m12_gen1
diff --git a/src/gencode/vava_p11_m12_generated2.F90 b/src/gencode/vava_p11_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b14d807352364d5d461601b3f74e3d37af897b94
--- /dev/null
+++ b/src/gencode/vava_p11_m12_generated2.F90
@@ -0,0 +1,269 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_p11_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_p11_m122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_p11_m122
+
+end module vava_p11_m12_gen2
diff --git a/src/gencode/vava_p11_m12_generated3.F90 b/src/gencode/vava_p11_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..475c8b90625c3222cb73eff8609dd3ae3d59f928
--- /dev/null
+++ b/src/gencode/vava_p11_m12_generated3.F90
@@ -0,0 +1,269 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_p11_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_p11_m123( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_p11_m123
+
+end module vava_p11_m12_gen3
diff --git a/src/gencode/vava_p11_m12_generated4.F90 b/src/gencode/vava_p11_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5969095fd9d27aed5dec0a53965d990de19a679d
--- /dev/null
+++ b/src/gencode/vava_p11_m12_generated4.F90
@@ -0,0 +1,268 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vava_p11_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vava_p11_m124( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =2
+
+ !CM2
+ call CM2_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM2, detCM2, detCM2orb)
+ do jpos = 1,nCM2
+ idetactJ = detCM2(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ call extract_detCMorb(detCM2orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ j = idetactJ - isftJ
+ JK = 0.d0
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl2(twoint,p1 ,diffJ(1),p2 ,diffJ(2))&
+ -delta(-1,spindiffJ(2))*&
+ ijkl2(twoint,p1 ,diffJ(2),p2 ,diffJ(1))
+ elm = sign_act * psign * (1 - 2* modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vava_p11_m124
+
+end module vava_p11_m12_gen4
diff --git a/src/gencode/vavo_000_m12_generated1.F90 b/src/gencode/vavo_000_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..82b714c0d58eeef649998b332273ec38729453be
--- /dev/null
+++ b/src/gencode/vavo_000_m12_generated1.F90
@@ -0,0 +1,251 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_000_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vavo_000_m121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vavo_000_m121
+
+end module vavo_000_m12_gen1
diff --git a/src/gencode/vavo_000_m12_generated2.F90 b/src/gencode/vavo_000_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4046c2d03995c5b5b29125fe1651c8241845c785
--- /dev/null
+++ b/src/gencode/vavo_000_m12_generated2.F90
@@ -0,0 +1,251 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_000_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vavo_000_m122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vavo_000_m122
+
+end module vavo_000_m12_gen2
diff --git a/src/gencode/vavo_000_m12_generated3.F90 b/src/gencode/vavo_000_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2bf0285a7bc208c0d910bf253d66fbced6f2569d
--- /dev/null
+++ b/src/gencode/vavo_000_m12_generated3.F90
@@ -0,0 +1,251 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_000_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vavo_000_m123( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vavo_000_m123
+
+end module vavo_000_m12_gen3
diff --git a/src/gencode/vavo_000_m12_generated4.F90 b/src/gencode/vavo_000_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4bcee2894cf758808705468ef58ef66769d646f2
--- /dev/null
+++ b/src/gencode/vavo_000_m12_generated4.F90
@@ -0,0 +1,250 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_000_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vavo_000_m124( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ t1-ngel ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(4), &
+ nocc+nligo+t1-ngel,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vavo_000_m124
+
+end module vavo_000_m12_gen4
diff --git a/src/gencode/vavo_generated.F90 b/src/gencode/vavo_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..af93c72d778dfea14ff54d7dbbc35e1bc0d3f299
--- /dev/null
+++ b/src/gencode/vavo_generated.F90
@@ -0,0 +1,48 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use vavo_000_m12_gen1
+ use vavo_000_m12_gen2
+ use vavo_000_m12_gen3
+ use vavo_000_m12_gen4
+ use vavo_p02_p11_gen1
+ use vavo_p02_p11_gen2
+ use vavo_p02_p11_gen3
+ use vavo_p02_p11_gen4
+end module vavo_gen
diff --git a/src/gencode/vavo_p02_p11_generated1.F90 b/src/gencode/vavo_p02_p11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..675a6f514ce04b9e23257d7b858a4badf9db0861
--- /dev/null
+++ b/src/gencode/vavo_p02_p11_generated1.F90
@@ -0,0 +1,597 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_p02_p11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vavo_p02_p111( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vavo_p02_p111
+
+end module vavo_p02_p11_gen1
diff --git a/src/gencode/vavo_p02_p11_generated2.F90 b/src/gencode/vavo_p02_p11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a9a8091e87f2dd406ff1528770784df336ff4a00
--- /dev/null
+++ b/src/gencode/vavo_p02_p11_generated2.F90
@@ -0,0 +1,597 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_p02_p11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vavo_p02_p112( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vavo_p02_p112
+
+end module vavo_p02_p11_gen2
diff --git a/src/gencode/vavo_p02_p11_generated3.F90 b/src/gencode/vavo_p02_p11_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4c561c0435a6837ea62e68624715fcd1c2564939
--- /dev/null
+++ b/src/gencode/vavo_p02_p11_generated3.F90
@@ -0,0 +1,597 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_p02_p11_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vavo_p02_p113( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vavo_p02_p113
+
+end module vavo_p02_p11_gen3
diff --git a/src/gencode/vavo_p02_p11_generated4.F90 b/src/gencode/vavo_p02_p11_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cf98949c3da1560fefd9ad1cec6a370a5ff4b0f8
--- /dev/null
+++ b/src/gencode/vavo_p02_p11_generated4.F90
@@ -0,0 +1,596 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vavo_p02_p11_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vavo_p02_p114( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t1 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p1 ,diffJ(1),p2 ,t2 )&
+ -delta(-1,spindiffJ(1))*&
+ ijkl1(twoint,p2 ,diffJ(1),p1 ,t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vavo_p02_p114
+
+end module vavo_p02_p11_gen4
diff --git a/src/gencode/voao_000_p12_generated1.F90 b/src/gencode/voao_000_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ad2f290f04b3dcbc4da1daf4b148ee4b8e354b0c
--- /dev/null
+++ b/src/gencode/voao_000_p12_generated1.F90
@@ -0,0 +1,377 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module voao_000_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_voao_000_p121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_voao_000_p121
+
+end module voao_000_p12_gen1
diff --git a/src/gencode/voao_000_p12_generated2.F90 b/src/gencode/voao_000_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..168c67f47191254fbe3194188889aa55df015f27
--- /dev/null
+++ b/src/gencode/voao_000_p12_generated2.F90
@@ -0,0 +1,373 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module voao_000_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_voao_000_p122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_voao_000_p122
+
+end module voao_000_p12_gen2
diff --git a/src/gencode/voao_generated.F90 b/src/gencode/voao_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..51de6a51d99291487eccf597b5e9c8d8bfab4c77
--- /dev/null
+++ b/src/gencode/voao_generated.F90
@@ -0,0 +1,46 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module voao_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use voao_000_p12_gen1
+ use voao_000_p12_gen2
+ use voao_p02_m11_gen1
+ use voao_p02_m11_gen2
+ use voao_p02_m11_gen3
+ use voao_p02_m11_gen4
+end module voao_gen
diff --git a/src/gencode/voao_p02_m11_generated1.F90 b/src/gencode/voao_p02_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5b9663d09e8549ff1bc3aeebaf9f8ada04669835
--- /dev/null
+++ b/src/gencode/voao_p02_m11_generated1.F90
@@ -0,0 +1,583 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module voao_p02_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_voao_p02_m111( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p2 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p2 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_voao_p02_m111
+
+end module voao_p02_m11_gen1
diff --git a/src/gencode/voao_p02_m11_generated2.F90 b/src/gencode/voao_p02_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6ce0c1ef653e4e4a8b675a607d9459a903300b55
--- /dev/null
+++ b/src/gencode/voao_p02_m11_generated2.F90
@@ -0,0 +1,581 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module voao_p02_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_voao_p02_m112( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_voao_p02_m112
+
+end module voao_p02_m11_gen2
diff --git a/src/gencode/voao_p02_m11_generated3.F90 b/src/gencode/voao_p02_m11_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..73473810b9b27445622c4bcbdae143d2fe51a160
--- /dev/null
+++ b/src/gencode/voao_p02_m11_generated3.F90
@@ -0,0 +1,581 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module voao_p02_m11_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_voao_p02_m113( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_voao_p02_m113
+
+end module voao_p02_m11_gen3
diff --git a/src/gencode/voao_p02_m11_generated4.F90 b/src/gencode/voao_p02_m11_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cab84f1f16d60e9b9e2ec99043515161df885c79
--- /dev/null
+++ b/src/gencode/voao_p02_m11_generated4.F90
@@ -0,0 +1,578 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module voao_p02_m11_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_voao_p02_m114( &
+ VmI, VmJ, spinrefI, dblockI, tmpWmI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,diffI(1),t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,diffI(1),t1 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftI + i) = &
+ tmpWmI(m, detshiftI + i) + &
+ elm*VmJ%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_voao_p02_m114
+
+end module voao_p02_m11_gen4
diff --git a/src/gencode/vooo_generated.F90 b/src/gencode/vooo_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5e1e84d2f6e078f2c7b2408961ba44be25e63fa3
--- /dev/null
+++ b/src/gencode/vooo_generated.F90
@@ -0,0 +1,46 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vooo_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use vooo_p01_p02_gen1
+ use vooo_p01_p02_gen2
+ use vooo_p01_p02_gen3
+ use vooo_p01_p02_gen4
+ use vooo_p11_p12_gen1
+ use vooo_p11_p12_gen2
+end module vooo_gen
diff --git a/src/gencode/vooo_p01_p02_generated1.F90 b/src/gencode/vooo_p01_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2cc383fc0de40df94e8ab97bdb5be71c20eb753f
--- /dev/null
+++ b/src/gencode/vooo_p01_p02_generated1.F90
@@ -0,0 +1,1095 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vooo_p01_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vooo_p01_p021( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p2 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p1 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UUU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ ! UUD0
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vooo_p01_p021
+
+end module vooo_p01_p02_gen1
diff --git a/src/gencode/vooo_p01_p02_generated2.F90 b/src/gencode/vooo_p01_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a88450ba4fc52707d22fa79ece9eed17154c7a3e
--- /dev/null
+++ b/src/gencode/vooo_p01_p02_generated2.F90
@@ -0,0 +1,1091 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vooo_p01_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vooo_p01_p022( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p1 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p2 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vooo_p01_p022
+
+end module vooo_p01_p02_gen2
diff --git a/src/gencode/vooo_p01_p02_generated3.F90 b/src/gencode/vooo_p01_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..58d5c9b5208efeee47e6fb6b45173ac967169815
--- /dev/null
+++ b/src/gencode/vooo_p01_p02_generated3.F90
@@ -0,0 +1,1091 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vooo_p01_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vooo_p01_p023( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p1 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! UDU0
+ !spinp3 = 1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p2 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ ! UDD0
+ !spinp3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vooo_p01_p023
+
+end module vooo_p01_p02_gen3
diff --git a/src/gencode/vooo_p01_p02_generated4.F90 b/src/gencode/vooo_p01_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ff90ad07f968da80590f579308d0c3a3fe04cecf
--- /dev/null
+++ b/src/gencode/vooo_p01_p02_generated4.F90
@@ -0,0 +1,1086 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vooo_p01_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vooo_p01_p024( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ ! DDU0
+ !spinp3 = 1
+ ! DDD0
+ !spinp3 = -1
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(20)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p2 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p2 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p2 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p2 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !p3 = p2
+ p3 = p2
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(28)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p1 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t3 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vooo_p01_p024
+
+end module vooo_p01_p02_gen4
diff --git a/src/gencode/vooo_p11_p12_generated1.F90 b/src/gencode/vooo_p11_p12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..7ae961510d7df76a419bc9b7dcffa57cd136e3fe
--- /dev/null
+++ b/src/gencode/vooo_p11_p12_generated1.F90
@@ -0,0 +1,634 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vooo_p11_p12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vooo_p11_p121( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p1 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ t1-ngel ,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !DUD0
+ !spint3 = -1
+ !t2 < t3 < t1
+ do t3 = isfth+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vooo_p11_p121
+
+end module vooo_p11_p12_gen1
diff --git a/src/gencode/vooo_p11_p12_generated2.F90 b/src/gencode/vooo_p11_p12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..98ae159f17263f48d7b1776e4b26f9b4600f3ff6
--- /dev/null
+++ b/src/gencode/vooo_p11_p12_generated2.F90
@@ -0,0 +1,628 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vooo_p11_p12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vooo_p11_p122( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1, t2
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !UUU0
+ !spint3 = 1
+ !UUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DUU0
+ !spint3 = 1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,t2-ngel ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !DUD0
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(4)%exponent, 2)
+ !DDU0
+ !spint3 = 1
+ !DDD0
+ !spint3 = -1
+ !t3 < t2 < t1
+ do t3 = isfth + 1, t2-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(14), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t3 = t2 < t1
+ t3 = t2
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(20), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t1 ,t2 ,t2 )&
+ +&
+ ijkl2(twoint,p1 ,t2 ,t1 ,t2 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t3 < t1
+ do t3 = t2+1, t1-1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(24), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ !t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(28), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK -ijkl2(twoint,p1 ,t2 ,t1 ,t1 )&
+ +&
+ ijkl2(twoint,p1 ,t1 ,t2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ !t2 < t1 < t3
+ do t3 = t1+1, isfth+nocc+nligo
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(30), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,t3 ,t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,t3 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !t3
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vooo_p11_p122
+
+end module vooo_p11_p12_gen2
diff --git a/src/gencode/vovo_000_p02_generated1.F90 b/src/gencode/vovo_000_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..537e1a80ed6dfafb043ae1beb6b4d1d8a77407b0
--- /dev/null
+++ b/src/gencode/vovo_000_p02_generated1.F90
@@ -0,0 +1,253 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vovo_000_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vovo_000_p021( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ t1-ngel ,t2-ngel ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,p2 ,t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,p2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vovo_000_p021
+
+end module vovo_000_p02_gen1
diff --git a/src/gencode/vovo_000_p02_generated2.F90 b/src/gencode/vovo_000_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9f532c2b68cf8d9b38aa1d29fe98edaaafc111ea
--- /dev/null
+++ b/src/gencode/vovo_000_p02_generated2.F90
@@ -0,0 +1,285 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vovo_000_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vovo_000_p022( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,p2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,p2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vovo_000_p022
+
+end module vovo_000_p02_gen2
diff --git a/src/gencode/vovo_000_p02_generated3.F90 b/src/gencode/vovo_000_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a2912af3c2de4427f2d8e1647e28a77513d139a6
--- /dev/null
+++ b/src/gencode/vovo_000_p02_generated3.F90
@@ -0,0 +1,285 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vovo_000_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vovo_000_p023( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,p2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,t2-ngel ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK &
+ -&
+ ijkl2(twoint,p1 ,t2 ,p2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vovo_000_p023
+
+end module vovo_000_p02_gen3
diff --git a/src/gencode/vovo_000_p02_generated4.F90 b/src/gencode/vovo_000_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5bf9fb2a0cdedf34efb4ed49d9bf4d0b22030738
--- /dev/null
+++ b/src/gencode/vovo_000_p02_generated4.F90
@@ -0,0 +1,252 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vovo_000_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vovo_000_p024( &
+ VmI, VmJ, spinrefJ, dblockJ, tmpWmI, tmpWmJ, nvec, spinrefI, dblockI, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI, VmJ
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmI, tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI, VmJ), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmI, tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmI) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(14) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(14)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(15) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(15)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(16) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(16)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinpJ = 0
+ detshiftJ = 0
+ detshiftpJ = 0
+ psign = 1 - 2 * modulo(pcase_info(13)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(13), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ JK = JK +&
+ ijkl2(twoint,p1 ,t1 ,p2 ,t2 )&
+ -&
+ ijkl2(twoint,p1 ,t2 ,p2 ,t1 )
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ do m = 1, nvec
+ tmpWmI(m, detshiftJ + j) = &
+ tmpWmI(m, detshiftJ + j) + &
+ elm*VmJ%elms(m, detshiftI + i)
+ enddo !m
+
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vovo_000_p024
+
+end module vovo_000_p02_gen4
diff --git a/src/gencode/vovo_generated.F90 b/src/gencode/vovo_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c1f0ef0d5367f5064e6fde68a95947488ed92277
--- /dev/null
+++ b/src/gencode/vovo_generated.F90
@@ -0,0 +1,44 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vovo_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use vovo_000_p02_gen1
+ use vovo_000_p02_gen2
+ use vovo_000_p02_gen3
+ use vovo_000_p02_gen4
+end module vovo_gen
diff --git a/src/gencode/vvaa_generated.F90 b/src/gencode/vvaa_generated.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c8879cddc66c3467455238a430e334bb8776cbcc
--- /dev/null
+++ b/src/gencode/vvaa_generated.F90
@@ -0,0 +1,58 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_gen
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+ use vvaa_p01_p01_gen1
+ use vvaa_p01_p01_gen2
+ use vvaa_p02_p02_gen1
+ use vvaa_p02_p02_gen2
+ use vvaa_p02_p02_gen3
+ use vvaa_p02_p02_gen4
+ use vvaa_p12_p12_gen1
+ use vvaa_p12_p12_gen2
+ use vvaa_m11_m11_gen1
+ use vvaa_m11_m11_gen2
+ use vvaa_m12_m12_gen1
+ use vvaa_m12_m12_gen2
+ use vvaa_m12_m12_gen3
+ use vvaa_m12_m12_gen4
+ use vvaa_m20_m20_gen1
+ use vvaa_m20_m20_gen2
+ use vvaa_m20_m20_gen3
+ use vvaa_m20_m20_gen4
+end module vvaa_gen
diff --git a/src/gencode/vvaa_m11_m11_generated1.F90 b/src/gencode/vvaa_m11_m11_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..95201083010aa9727423058a3accfb3293e4f593
--- /dev/null
+++ b/src/gencode/vvaa_m11_m11_generated1.F90
@@ -0,0 +1,258 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m11_m11_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m11_m111( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vvaa_m11_m111
+
+end module vvaa_m11_m11_gen1
diff --git a/src/gencode/vvaa_m11_m11_generated2.F90 b/src/gencode/vvaa_m11_m11_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4289a84a658d27e9db2e6a2526e9f2da80f07ff2
--- /dev/null
+++ b/src/gencode/vvaa_m11_m11_generated2.F90
@@ -0,0 +1,302 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m11_m11_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m11_m112( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: p3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact-1))
+ allocate(spinandIJ(nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vvaa_m11_m112
+
+end module vvaa_m11_m11_gen2
diff --git a/src/gencode/vvaa_m12_m12_generated1.F90 b/src/gencode/vvaa_m12_m12_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ca62cd0401bf761886f087cdb0bcbf6c33f1e80f
--- /dev/null
+++ b/src/gencode/vvaa_m12_m12_generated1.F90
@@ -0,0 +1,815 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m12_m12_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m12_m121( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_m12_m121
+
+end module vvaa_m12_m12_gen1
diff --git a/src/gencode/vvaa_m12_m12_generated2.F90 b/src/gencode/vvaa_m12_m12_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c0a4f707ec077e250736e6bd2cf5e74481946045
--- /dev/null
+++ b/src/gencode/vvaa_m12_m12_generated2.F90
@@ -0,0 +1,1531 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m12_m12_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m12_m122( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_m12_m122
+
+end module vvaa_m12_m12_gen2
diff --git a/src/gencode/vvaa_m12_m12_generated3.F90 b/src/gencode/vvaa_m12_m12_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..37c4751ee7fb6f2f7251e766f344f49ec530a85e
--- /dev/null
+++ b/src/gencode/vvaa_m12_m12_generated3.F90
@@ -0,0 +1,1531 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m12_m12_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m12_m123( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(5)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(6)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 4
+ isftJ = spinrefJ%ShiftSpinCat(4)
+ ndetactJ = spinrefJ%NdetSpinCat(4)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_m12_m123
+
+end module vvaa_m12_m12_gen3
diff --git a/src/gencode/vvaa_m12_m12_generated4.F90 b/src/gencode/vvaa_m12_m12_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f94ffe316471e45a996536f0536fd66250894efe
--- /dev/null
+++ b/src/gencode/vvaa_m12_m12_generated4.F90
@@ -0,0 +1,1264 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m12_m12_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m12_m124( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1
+ integer :: p3, p4
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(7)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(5)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(7)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(8)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(6)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-1))
+ allocate(spinandIJ(Nelact-1))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-1
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(8)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_m12_m124
+
+end module vvaa_m12_m12_gen4
diff --git a/src/gencode/vvaa_m20_m20_generated1.F90 b/src/gencode/vvaa_m20_m20_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ff0fd91ddd70379523ed1bcb14a6281f50e2d1fd
--- /dev/null
+++ b/src/gencode/vvaa_m20_m20_generated1.F90
@@ -0,0 +1,434 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m20_m20_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m20_m201( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ detshiftI = detshiftpI
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_m20_m201
+
+end module vvaa_m20_m20_gen1
diff --git a/src/gencode/vvaa_m20_m20_generated2.F90 b/src/gencode/vvaa_m20_m20_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1402f7f399def33ec38405a60199abce71d9649f
--- /dev/null
+++ b/src/gencode/vvaa_m20_m20_generated2.F90
@@ -0,0 +1,752 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m20_m20_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m20_m202( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_m20_m202
+
+end module vvaa_m20_m20_gen2
diff --git a/src/gencode/vvaa_m20_m20_generated3.F90 b/src/gencode/vvaa_m20_m20_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..4a51e5c0cfc049da4a3539ee9293f084e7633374
--- /dev/null
+++ b/src/gencode/vvaa_m20_m20_generated3.F90
@@ -0,0 +1,752 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m20_m20_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m20_m203( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ detshiftI = detshiftpI
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_m20_m203
+
+end module vvaa_m20_m20_gen3
diff --git a/src/gencode/vvaa_m20_m20_generated4.F90 b/src/gencode/vvaa_m20_m20_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..56b401a8ce4fd19da6c8886999a32223b539502a
--- /dev/null
+++ b/src/gencode/vvaa_m20_m20_generated4.F90
@@ -0,0 +1,626 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_m20_m20_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_m20_m204( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: p3, p4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ detshiftI = detshiftpI
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ endif !p2 in ligv
+ !DDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p4
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact-2))
+ allocate(spinandIJ(Nelact-2))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact-2
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(4) &
+ + (dblockJ%shiftp_array(p4-isftp)+ (p3-isftp-1))*dblockJ%deltashiftp_array(4)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ detshiftJ = detshiftpJ
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(1), &
+ 0 ,0 ,0 ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p2 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !i
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_m20_m204
+
+end module vvaa_m20_m20_gen4
diff --git a/src/gencode/vvaa_p01_p01_generated1.F90 b/src/gencode/vvaa_p01_p01_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..afe3f7aa4668f7638b8ba74eaf136298f72ef501
--- /dev/null
+++ b/src/gencode/vvaa_p01_p01_generated1.F90
@@ -0,0 +1,436 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_p01_p01_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_p01_p011( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !p1 up
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinp1 = 1
+ !spinpI = -1
+ detshiftpI = dblockI%shiftspinp_array(1) + (p1-isftp-1)*dblockI%deltashiftp_array(1)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(1)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !p3 dn
+ !spinp3 = -1
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vvaa_p01_p011
+
+end module vvaa_p01_p01_gen1
diff --git a/src/gencode/vvaa_p01_p01_generated2.F90 b/src/gencode/vvaa_p01_p01_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fdc6827685aab0ec744865af394bb1dc9714b0ba
--- /dev/null
+++ b/src/gencode/vvaa_p01_p01_generated2.F90
@@ -0,0 +1,542 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_p01_p01_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_p01_p012( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1
+ integer :: t1
+ integer :: p3
+ integer :: t3
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1), &
+ !$OMP& PRIVATE(t1), &
+ !$OMP& PRIVATE(p3), &
+ !$OMP& PRIVATE(t3), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist),&
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !p1 dn
+ do p1 = isftp + pmin + 1, isftp + pmax
+ !spinpI = 1
+ !spinp1 = -1
+ detshiftpI = dblockI%shiftspinp_array(2) +(p1-isftp-1)*dblockI%deltashiftp_array(2)
+ !t1 up
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(3)
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(3)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ t1-ngel ,0 ,t3-ngel ,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ !t3 dn
+ !spint3 = -1
+ enddo !i
+ enddo !t1
+
+ !t1 dn
+ do t1 = isfth + 1, isfth+nocc+nligo
+ !spint1 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (t1-isfth-1) * dblockI%deltashifth_array(4)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ detshiftJ = 0
+ !p3 up
+ !spinp3 = +1
+ do p3 = isftp + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(1) +(p3-isftp-1)*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !p3
+ !p3 dn
+ !spinp3 = -1
+ !p3 < p1
+ do p3 = isftp + 1, p1-1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(5)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(nelact ))
+ allocate(spinandIJ(nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !p3
+ !p3 = p1
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) +(p3-isftp-1)*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(9)%exponent, 2)
+ !t3 up
+ !spint3 = 1
+ !dn t3 < t1
+ !spint3 = -1
+ !t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (t3-isfth-1) * dblockJ%deltashifth_array(4)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(9), &
+ nocc+nligo+t1-ngel,0 ,nocc+nligo+t3-ngel,0 )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p1 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+
+ enddo !i
+ enddo !t1
+ enddo !p1
+ !$OMP END DO
+ !$OMP END PARALLEL
+ end subroutine hv_blocs_vvaa_p01_p012
+
+end module vvaa_p01_p01_gen2
diff --git a/src/gencode/vvaa_p02_p02_generated1.F90 b/src/gencode/vvaa_p02_p02_generated1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a395c4b153f74462a1707eb5e76287aef941da51
--- /dev/null
+++ b/src/gencode/vvaa_p02_p02_generated1.F90
@@ -0,0 +1,2243 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_p02_p02_gen1
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_p02_p021( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !UU
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ detshiftpI = dblockI%shiftspinp_array(1) &
+ + (dblockI%shiftp_array(p2-isftp) + (p1-isftp-1))*dblockI%deltashiftp_array(1)
+ !spinp1 = 1
+ !spinp2 = 1
+ !spinpI = -2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(1) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(1)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(2) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(2)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(3) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(3)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(4) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(4)
+ !indxI = 5
+ isftI = spinrefI%ShiftSpinCat(5)
+ ndetactI = spinrefI%NdetSpinCat(5)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !UUUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p1 < p4 < p2
+ !p3<p1<p4<p2
+ do p4 = p1 + 1, p2-1
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !Case p3 in virtU and p4 in ligvD
+ !p1 in ligvU and p2 in ligvU+virtU
+ !spinp3 = -1
+ !spinp4 = -1
+ !UUDD
+ enddo !i
+ enddo !t1
+ enddo !t2
+ enddo !p1
+ enddo !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_p02_p021
+
+end module vvaa_p02_p02_gen1
diff --git a/src/gencode/vvaa_p02_p02_generated2.F90 b/src/gencode/vvaa_p02_p02_generated2.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e3473deed33ab1fb68a7ba06aadbc6e7a7140c2d
--- /dev/null
+++ b/src/gencode/vvaa_p02_p02_generated2.F90
@@ -0,0 +1,4492 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_p02_p02_gen2
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_p02_p022( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(2) &
+ +((p2-isftp-1)*nligv + (p1-isftp-1))*dblockI%deltashiftp_array(2)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(5) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(5)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(6) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(6)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(7) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(7)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(8) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(8)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_p02_p022
+
+end module vvaa_p02_p02_gen2
diff --git a/src/gencode/vvaa_p02_p02_generated3.F90 b/src/gencode/vvaa_p02_p02_generated3.F90
new file mode 100644
index 0000000000000000000000000000000000000000..737fe784ef3603862f7e4d2a910945b4637080a6
--- /dev/null
+++ b/src/gencode/vvaa_p02_p02_generated3.F90
@@ -0,0 +1,4492 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_p02_p02_gen3
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_p02_p023( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+ !UD
+ !Case p1 in virtU and p2 in ligvD
+ do p1 = isftp + max(nligv, pmin) + 1, isftp + pmax
+ do p2 = isftp + 1, isftp + nligv
+ detshiftpI = dblockI%shiftspinp_array(3) &
+ +((p2-isftp-1)*nvirt + (p1-isftp-nligv-1))*dblockI%deltashiftp_array(3)
+ !spinp1 = 1
+ !spinp2 = -1
+ !spinpI = 0
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(9) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(9)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 2
+ isftI = spinrefI%ShiftSpinCat(2)
+ ndetactI = spinrefI%NdetSpinCat(2)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(1) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(1)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = isfth + nocc + 1, isfth + nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(10) + &
+ ((t2-isfth-1)*nligo + t1 - (isfth+nocc+1)) * &
+ dblockI%deltashifth_array(10)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DU
+ do t1 = isfth + 1, isfth + nocc
+ do t2 = isfth + nocc + 1, isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = +1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(11) + &
+ ((t2-isfth-nocc-1)*nocc + t1 - (isfth+1)) * &
+ dblockI%deltashifth_array(11)
+ !indxI = 1
+ isftI = spinrefI%ShiftSpinCat(1)
+ ndetactI = spinrefI%NdetSpinCat(1)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(2) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(2)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(3) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(3)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(6) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(6)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(7) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(7)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ else ! t1 in occ
+ endif !t1
+ !DUDU
+ !spint3 = -1
+ !spint4 = 1
+ if ( t1 .gt. isfth+nocc) then !t1 in ligo
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(10) + &
+ ((t4-isfth-1)*nligo + t3 - (isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(10)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ else !t1 in occ
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(11) + &
+ ((t4-isfth-nocc-1)*nocc + t3 - (isfth+1)) * &
+ dblockJ%deltashifth_array(11)
+ !indxJ = 1
+ isftJ = spinrefJ%ShiftSpinCat(1)
+ ndetactJ = spinrefJ%NdetSpinCat(1)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,t2-ngel ,nocc+nligo+t3-ngel,t4-ngel )
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !t1
+ !DUDD
+ !spint3 = -1
+ !spint4 = -1
+ if ( t1 .gt.isfth+nocc) then !t1 in ligo
+ else !t1 in occ
+ endif !t1
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+
+ !DD
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ !spint1 = -1
+ !spint2 = -1
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(12) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(12)
+ !indxI = 3
+ isftI = spinrefI%ShiftSpinCat(3)
+ ndetactI = spinrefI%NdetSpinCat(3)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !spinp3 = 1
+ !spinp4 = 1
+ !UDUU
+ !*** p4 < p1
+ !*** p4 = p1
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, min(p4-1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p1 < p4 < p2
+ do p4 = p1 + 1, isftp + nligv + nvirt
+ if( p1 .le. isftp + nligv) then
+ !p3=p1<p4<p2
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(1) &
+ + (dblockJ%shiftp_array(p4-isftp) + (p3-isftp-1))*dblockJ%deltashiftp_array(1)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(4) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(4)
+ !indxJ = 5
+ isftJ = spinrefJ%ShiftSpinCat(5)
+ ndetactJ = spinrefJ%NdetSpinCat(5)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1 in ligv
+ enddo !p4
+ !UDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p1 in ligvU and p2 in ligvD+virtD
+ if( p1 .le. isftp + nligv) then
+ !*** p4 < p2
+ do p4 = isftp + 1, p2-1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3=p1<p4<p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ enddo !p4
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, min(p1 - 1, isftp + nligv)
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ if (p2 .le. isftp + nligv) then !p2 in ligv
+ endif !p2 in ligv
+ else !Case p1 in virtU and p2 in ligvD
+ !*** p4 = p2
+ !p3<p1<p4=p2
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(8) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(8)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !*** p4 < p2
+ !Case p1 in virtU and p2 in ligvD
+ !Case p3 in virtU and p4 in ligvD
+ do p4 = isftp + 1, p2-1
+ !p3=p1<p4<p2
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(21)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p2 ,p4 ,andIJ(k),andIJ(k))&
+ -delta(-1,spinandIJ(k))*&
+ ijkl2(twointx,p2 ,andIJ(k),p4 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p2 ,p4 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p4 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p4
+ !*** p4 = p2
+ !Case p3 in virtU and p4 in ligvD
+ p4 = p2
+ !p3<p1<p4=p2
+ do p3 = isftp + nligv + 1, p1 - 1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =0
+
+ !Identity
+ j = i
+ idetactJ = isftJ + j
+ detactJ = spinrefJ%elms(idetactJ)
+ call sign_diff(detactI, detactJ,diffilist, diffjlist, andijlist, sign_act, nact)
+ JK = 0.d0
+ allocate(andIJ(Nelact ))
+ allocate(spinandIJ(Nelact ))
+ call extract_orbindx_from_detact(andIJlist, andIJ, spinandIJ,no, nact)
+ do k = 1, Nelact
+ JK = JK +ijkl2(twoint,p1 ,p3 ,andIJ(k),andIJ(k))&
+ -delta(1,spinandIJ(k))*&
+ ijkl2(twointx,p1 ,andIJ(k),p3 ,andIJ(k))
+ end do
+ deallocate(andIJ)
+ deallocate(spinandIJ)
+ elm = psign * tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +&
+ ijkl2(twoint,p1 ,p3 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ end do !p3
+ !p1=p3<p2=p4
+ !Case p3 in virtU and p4 in ligvD
+ p3 = p1
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(22)%exponent, 2)
+ !DDUU
+ !spint3 = 1
+ !spint4 = 1
+ !DDDU
+ !spint3 = -1
+ !spint4 = 1
+ !DDDD
+ !spint3 = -1
+ !spint4 = -1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(12) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(12)
+ !indxJ = 3
+ isftJ = spinrefJ%ShiftSpinCat(3)
+ ndetactJ = spinrefJ%NdetSpinCat(3)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ nocc+nligo+t1-ngel,nocc+nligo+t2-ngel,nocc+nligo+t3-ngel,nocc+nligo+t4-ngel)
+
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .lt. idetactI)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK +ijkl2(twoint,p1 ,p1 ,diffI(1),diffJ(1))&
+ -delta(1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),diffI(1),p1 )
+ JK = JK +ijkl2(twoint,p2 ,p2 ,diffI(1),diffJ(1))&
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),diffI(1),p2 )
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ endif !p1
+ !UDDD
+ !spinp3 = -1
+ !spinp4 = -1
+ enddo !i
+ enddo !t1
+ enddo !t2
+ end do !p1
+ end do !p2
+ !$OMP END DO
+
+ !$OMP END PARALLEL
+
+ end subroutine hv_blocs_vvaa_p02_p023
+
+end module vvaa_p02_p02_gen3
diff --git a/src/gencode/vvaa_p02_p02_generated4.F90 b/src/gencode/vvaa_p02_p02_generated4.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d3b778e48c9ec18de188cec94f5b0587b350ddcf
--- /dev/null
+++ b/src/gencode/vvaa_p02_p02_generated4.F90
@@ -0,0 +1,3706 @@
+!!-------------------------------------------------------
+!!---- Relaxed Selected Excitation (RelaxSE)
+!!-------------------------------------------------------
+!!---- This file is part of RelaxSE
+!!----
+!!---- The RelaxSE project is distributed under LGPL. In agreement with the
+!!---- Intergovernmental Convention of the ILL, this software cannot be used
+!!---- in military applications.
+!!----
+!!---- Copyright (C) 2016-2021 Institut Laue-Langevin (ILL), Grenoble, FRANCE
+!!---- Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
+!!----
+!!---- Authors: Elisa REBOLINI (ILL) rebolini@ill.fr
+!!---- Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr
+!!----
+!!---- RelaxSE is free software; you can redistribute it and/or
+!!---- modify it under the terms of the GNU Lesser General Public
+!!---- License as published by the Free Software Foundation; either
+!!---- version 3.0 of the License, or (at your option) any later version.
+!!----
+!!---- RelaxSE is distributed in the hope that it will be useful,
+!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
+!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+!!---- Lesser General Public License for more details.
+!!----
+!!---- You should have received a copy of the GNU Lesser General Public
+!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
+!!----
+!This code was generated by hvblock.x: DO NOT EDIT !
+module vvaa_p02_p02_gen4
+
+ use info
+ use detact
+ use spindetact
+ use typedet
+ use utils_twoint
+ use utils_wrt
+ use utils_intcase
+ use hole_part_cases
+
+ implicit none
+
+contains
+
+ subroutine hv_blocs_vvaa_p02_p024( &
+ VmI, spinrefI, dblockI, tmpWmJ, nvec, spinrefJ, dblockJ, o_info, &
+ nelact, hcase_info, pcase_info, &
+ pmin, pmax, twoint, twointx)
+ type(deter_dblock), pointer, intent(in) :: DblockI, DblockJ
+ type(spindetact_list), pointer, intent(in) :: spinrefI, spinrefJ
+ type(vecMblock), pointer, intent(in) :: VmI
+ real(kd_dble), dimension(:,:), allocatable, intent(inout) :: tmpWmJ
+ type(o_infotype), intent(in) :: o_info
+ integer, intent(in) :: nvec, nelact, pmin, pmax
+ type(case_infotype), intent(in) :: hcase_info(:), pcase_info(:)
+ type(intblock), intent(in) :: twoint, twointx
+
+ integer :: ngel, nocc, nligo, nact, nligv, nvirt, ntot, no
+ integer :: isftp, isfth
+ integer :: isftI, ndetactI, idetactI
+ integer :: isftJ, ndetactJ, idetactJ
+ integer(kindact) :: detactI, detactJ
+ integer :: i, j, k, jpos, m
+ integer :: p1, p2
+ integer :: t1, t2
+ integer :: p3, p4
+ integer :: t3, t4
+ integer :: detshiftpI, detshiftI
+ integer :: detshiftpJ, detshiftJ
+
+ integer :: Nh_I, Nh_J
+ integer :: Ndiffact_I, Ndiffact_J
+ integer(kindact) :: diffilist, diffjlist, andijlist
+ integer :: psign, tsign, sign_act
+ integer, dimension(2) :: diffi, diffj, spindiffi, spindiffj
+ integer, allocatable :: andIJ(:), spinandIJ(:)
+ integer :: nCM1, nCM2
+ integer, pointer :: detCM1(:), detCM2(:)
+ type(connectp), pointer :: detCM1orb(:), detCM2orb(:)
+ real(kd_dble) :: JK, elm
+
+ ngel = o_info%ngel
+ nocc = o_info%nocc
+ nligo = o_info%nligo
+ nact = o_info%nact
+ nligv = o_info%nligv
+ nvirt = o_info%nvirt
+ ntot = o_info%ntot
+ no = o_info%nocc + o_info%nligo + o_info%ngel
+ isftp = (ngel+nocc+nligo+nact)
+ isfth = ngel
+
+ detshiftpI = 0
+ detshiftI = 0
+ detshiftpJ = 0
+ detshiftJ = 0
+
+ Nh_I = dblockI%nexcOcc
+ Nh_J = dblockJ%nexcOcc
+ !$OMP PARALLEL DEFAULT(NONE) &
+ !$OMP& SHARED(dblockI, spinrefI, pcase_info, hcase_info), &
+ !$OMP& SHARED(dblockJ, spinrefJ, nelact, nvec, VmI), &
+ !$OMP& SHARED(ngel, nocc, nligo, nact, nligv, nvirt, ntot), &
+ !$OMP& SHARED(no, isftp, isfth, Nh_I, Nh_J, pmin, pmax), &
+ !$OMP& SHARED(twoint, twointx), &
+ !$OMP& SHARED(tmpWmJ), &
+ !$OMP& PRIVATE(p1, p2), &
+ !$OMP& PRIVATE(t1, t2), &
+ !$OMP& PRIVATE(p3, p4), &
+ !$OMP& PRIVATE(t3, t4), &
+ !$OMP& PRIVATE(isftI, ndetactI, isftJ, ndetactJ), &
+ !$OMP& PRIVATE(i, j, k, jpos, m), &
+ !$OMP& PRIVATE(Ndiffact_I, Ndiffact_J, diffilist, diffjlist, andijlist), &
+ !$OMP& PRIVATE(psign, tsign, sign_act, diffi, diffj, spindiffi, spindiffj), &
+ !$OMP& PRIVATE(andIJ, spinandIJ, nCM1, nCM2, detCM1, detCM2, detCM1orb, detCM2orb, JK, elm), &
+ !$OMP& PRIVATE(idetactI, idetactJ, detactI, detactJ), &
+ !$OMP& FIRSTPRIVATE(detshiftI, detshiftpI, detshiftJ, detshiftpJ)
+ !$OMP DO SCHEDULE(RUNTIME) reduction(+:tmpWmJ)
+
+ !DD
+ do p2 = isftp + pmin + 1, isftp + pmax
+ do p1 = isftp + 1, min(p2-1, isftp + nligv)
+ !spinp1 = -1
+ !spinp2 = -1
+ detshiftpI = dblockI%shiftspinp_array(4) &
+ + (dblockI%shiftp_array(p2-isftp)+ (p1-isftp-1))*dblockI%deltashiftp_array(4)
+ !spinpI = +2
+ !UU
+ do t2 = isfth + 1, isfth+nocc+nligo
+ do t1 = max(t2+1,isfth+nocc+1), isfth+nocc+nligo
+ detshiftI = detshiftpI + dblockI%shiftspinh_array(13) + &
+ (dblockI%shifth_array(t2-isfth) + t1 - max(t2+1,isfth+nocc+1)) * &
+ dblockI%deltashifth_array(13)
+ !spint1 = +1
+ !spint2 = +1
+ !indxI = 4
+ isftI = spinrefI%ShiftSpinCat(4)
+ ndetactI = spinrefI%NdetSpinCat(4)
+ do i = 1, ndetactI
+ idetactI = isftI+i
+ detactI = spinrefI%elms(idetactI)
+ !DDUU
+ !spinp3 = 1
+ !spinp4 = 1
+ !DDUD
+ !spinp3 = 1
+ !spinp4 = -1
+ !Case p3 in ligvU and p4 in ligvD+virtD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p2 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !p3<p1<p4=p2
+ p4 = p2
+ do p3 = isftp + 1, isftp + nligv
+ detshiftpJ = dblockJ%shiftspinp_array(2) &
+ +((p4-isftp-1)*nligv + (p3-isftp-1))*dblockJ%deltashiftp_array(2)
+ psign = 1 - 2 * modulo(pcase_info(18)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(5) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(5)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &
+ t1-ngel ,t2-ngel ,t3-ngel ,t4-ngel )
+
+ !actcase =0
+
+ !Identity wrong spin
+ !actcase =1
+
+ !CM1
+ call CM1_spindetact_list(spinrefI, spinrefJ, idetactI, nact, &
+ nCM1, detCM1, detCM1orb)
+ do jpos = 1,nCM1
+ idetactJ = detCM1(jpos)
+ if ((idetactJ .ge. isftJ +1) .and. &
+ (idetactJ .le. isftJ + ndetactJ)) then
+ j = idetactJ - isftJ
+ JK = 0.d0
+ call extract_detCMorb(detCM1orb(jpos)%p,diffi, diffj, spindiffi, spindiffj, sign_act, &
+ Ndiffact_I, Ndiffact_J)
+ JK = JK &
+ -delta(-1,spindiffJ(1))*&
+ ijkl2(twointx,p1 ,diffJ(1),p3 ,diffI(1))
+ elm = sign_act * psign * (1 - 2*modulo((Nh_I*Ndiffact_I + Nh_J*Ndiffact_J),2)) * &
+ tsign * JK
+
+ do m = 1, nvec
+ tmpWmJ(m, detshiftJ + j) = &
+ tmpWmJ(m, detshiftJ + j) + &
+ elm*VmI%elms(m, detshiftI + i)
+ !Add the symmetric W_i += H_ji * V_j
+ tmpWmJ(m, detshiftI + i) = &
+ tmpWmJ(m, detshiftI + i) + &
+ elm*VmI%elms(m, detshiftJ + j)
+ enddo !m
+
+ endif
+ enddo !jpos
+ !UUDU
+ !spint3 = -1
+ !spint4 = 1
+ !t3 in ligoD t4 in occU+ligoU
+ !t3 in occD t4 in ligoU
+ !UUDD
+ !spint3 = -1
+ !spint4 = -1
+ end do !p3
+ !Case p3 in virtU and p4 in ligvD
+ !p3<p4=p1<p2
+ p4 = p1
+ do p3 = isftp + nligv + 1, isftp + nligv + nvirt
+ detshiftpJ = dblockJ%shiftspinp_array(3) &
+ +((p4-isftp-1)*nvirt + (p3-isftp-nligv-1))*dblockJ%deltashiftp_array(3)
+ psign = 1 - 2 * modulo(pcase_info(16)%exponent, 2)
+ !spint3 = 1
+ !spint4 = 1
+ !*** t4 = t2
+ t4 = t2
+ !t4 = t2 < t3 = t1
+ t3 = t1
+ detshiftJ = detshiftpJ + dblockJ%shiftspinh_array(9) + &
+ (dblockJ%shifth_array(t4-isfth) + t3 - max(t4+1,isfth+nocc+1)) * &
+ dblockJ%deltashifth_array(9)
+ !indxJ = 2
+ isftJ = spinrefJ%ShiftSpinCat(2)
+ ndetactJ = spinrefJ%NdetSpinCat(2)
+
+ tsign = calc_hole_sign(hcase_info(22), &